Add Com.MusicMeetsComics

10 files changed, 2086 insertions, 0 deletions

diff --git a/Com/MusicMeetsComics/Aero.hs b/Com/MusicMeetsComics/Aero.hs
new file mode 100644
index 0000000..26d8aaf
--- /dev/null
+++ b/Com/MusicMeetsComics/Aero.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Com.MusicMeetsComics.Aero where
+
+import           Com.MusicMeetsComics.App ( Action(..)
+                                          , Comic(..)
+                                          , ComicReaderState(..)
+                                          , ComicReaderView(..)
+                                          , Model(..)
+                                          , AudioState(..)
+                                          , audioId
+                                          , chooseExperienceLink
+                                          , comicPlayerSpreadLink
+                                          , comicPlayerFullLink
+                                          , comicVideoLink
+                                          , handlers
+                                          , initModel
+                                          , the404
+                                          , routes
+                                          )
+import qualified Com.Simatime.Network as Network
+import           Data.Aeson ( eitherDecodeStrict )
+import qualified Data.Set as Set
+import qualified GHC.Show as Legacy
+import           JavaScript.Web.XMLHttpRequest ( Request(..)
+                                               , Method(GET)
+                                               , RequestData(NoData)
+                                               , contents
+                                               , xhrByteString
+                                               )
+import           Miso
+import           Miso.Effect.DOM (scrollIntoView)
+import qualified Miso.FFI.Audio as Audio
+import qualified Miso.FFI.Document as Document
+import qualified Miso.FFI.Fullscreen as Fullscreen
+import           Miso.String
+import           Protolude
+
+-- | Entry point for a miso application
+main :: IO ()
+main = miso $ \currentURI -> App { model = initModel currentURI, .. }
+  where
+    update        = move
+    view          = see
+    subs          = [ uriSub HandleURI
+                    , keyboardSub keynav
+                    ]
+    events        = defaultEvents
+    initialAction = FetchComics
+    mountPoint    = Nothing
+
+(∈) :: Ord a => a -> Set a -> Bool
+(∈) = Set.member
+
+-- | Keyboard navigation - maps keys to actions.
+keynav :: Set Int -> Action
+keynav ks
+    | 37 ∈ ks = PrevPage -- ^ left arrow
+    | 39 ∈ ks = NextPage -- ^ right arrow
+    | 191 ∈ ks = DumpModel -- ^ ?
+    | 32 ∈ ks = ToggleAudio audioId -- ^ SPC
+    | otherwise = NoOp
+
+see :: Model -> View Action
+see model =
+    case runRoute routes handlers uri model of
+      Left  _ -> the404 model
+      Right v -> v
+
+-- | Console-logging
+foreign import javascript unsafe "console.log($1);"
+  say :: MisoString -> IO ()
+
+-- | Updates model, optionally introduces side effects
+move :: Action -> Model -> Effect Action Model
+move NoOp      model = noEff model
+move DumpModel model = model <# do
+    say $ ms $ Legacy.show model
+    pure NoOp
+move (SelectExperience comic) model = model { cpState = ChooseExperience (comicId comic) 1 }
+    <# do pure $ ChangeURI $ chooseExperienceLink (comicId comic) 1
+move (StartReading comic) model = model { cpState = Reading Spread (comicId comic) 1 }
+    <# do pure $ ChangeURI $ comicPlayerSpreadLink (comicId comic) 1
+move (StartWatching comic) model = model { cpState = Watching (comicId comic) }
+    <# do pure $ ChangeURI $ comicVideoLink (comicId comic) 1
+move NextPage model = case cpState model of
+    Reading Spread id pg ->
+        model { cpState = Reading Spread id (pg+2) } <# do
+        pure $ ChangeURI $ comicPlayerSpreadLink id (pg+2)
+    Reading Full id pg ->
+        model { cpState = Reading Full id (pg+1) } <# do
+        pure $ ChangeURI $ comicPlayerFullLink id (pg+1)
+    Cover id ->
+        model { cpState = Reading Spread id 1 } <# do
+        pure $ ChangeURI $ comicPlayerSpreadLink id 1
+    _ -> noEff model
+move PrevPage model = case cpState model of
+    Reading Spread id pg ->
+        model { cpState = Reading Spread id (pg-2) } <# do
+        pure $ ChangeURI $ comicPlayerSpreadLink id (pg-2)
+    Reading Full id pg ->
+        model { cpState = Reading Full id (pg-1) } <# do
+        pure $ ChangeURI $ comicPlayerFullLink id (pg-1)
+    Cover _ -> noEff model
+    _ -> noEff model
+move (ToggleZoom c pg) m = m { cpState = newState } <# do pure act
+    where
+        goto lnk = ChangeURI $ lnk (comicId c) pg
+        reading v = Reading v (comicId c) pg
+        (newState, act) = case cpState m of
+              Reading Full _ _ -> (reading Spread, goto comicPlayerSpreadLink)
+              Reading Spread _ _ -> (reading Full, goto comicPlayerFullLink)
+              x -> (x, NoOp)
+move (ToggleInLibrary c) model = model { userLibrary = newLib } <# pure NoOp
+    where
+        newLib | c `elem` (userLibrary model) =
+                     Protolude.filter (/= c) $ userLibrary model
+               | otherwise = c : (userLibrary model)
+move (HandleURI u) model = model { uri = u } <# pure NoOp
+move (ChangeURI u) model = model <# do
+  pushURI u
+  pure NoOp
+move FetchComics      model = model <# (SetComics <$> fetchComics)
+move (SetComics   cs) model = noEff model { appComics = cs }
+move (ToggleAudio i ) model = model { cpAudioState = newState } <# do
+  el <- Document.getElementById i
+  toggle el
+  pure NoOp
+ where
+  (newState, toggle) = case cpAudioState model of
+    Playing -> (Paused, Audio.pause)
+    Paused  -> (Playing, Audio.play)
+move ToggleFullscreen model = model { cpState = newState } <# do
+    el <- Document.querySelector "body"
+    -- TODO: check Document.fullscreenEnabled
+    -- https://developer.mozilla.org/en-US/docs/Web/API/Document/fullscreenEnabled
+    _ <- toggle el
+    pure NoOp
+  where
+   (toggle, newState) = case cpState model of
+       Reading Full c n -> (const Fullscreen.exit, Reading Full c n)
+       Reading Spread c n -> (Fullscreen.request, Reading Spread c n)
+       -- otherwise, do nothing:
+       x -> (pure, x)
+move (SetMediaInfo x) model = model { dMediaInfo = x } <# do
+    case x of
+        Just Comic {comicId = id} ->
+            pure $ ScrollIntoView $ "comic-" <> ms id
+        Nothing ->
+            pure NoOp
+move (ScrollIntoView id) model = model <# do
+    say $ ms $ Legacy.show id
+    scrollIntoView id
+    pure NoOp
+
+fetchComics :: IO (Network.RemoteData MisoString [Comic])
+fetchComics = do
+  mjson <- contents <$> xhrByteString req
+  case mjson of
+    Nothing   ->
+      pure $ Network.Failure "Could not fetch comics from server."
+    Just json -> pure $ Network.fromEither
+      $ either (Left . ms) pure
+      $ eitherDecodeStrict json
+ where
+  req = Request
+    { reqMethod = GET
+    , reqURI = "/api/comic" -- FIXME: can we replace this hardcoding?
+    , reqLogin = Nothing
+    , reqHeaders = []
+    , reqWithCredentials = False
+    , reqData = NoData
+    }
diff --git a/Com/MusicMeetsComics/Apex.hs b/Com/MusicMeetsComics/Apex.hs
new file mode 100644
index 0000000..f652f68
--- /dev/null
+++ b/Com/MusicMeetsComics/Apex.hs
@@ -0,0 +1,235 @@
+{-# 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
diff --git a/Com/MusicMeetsComics/App.hs b/Com/MusicMeetsComics/App.hs
new file mode 100644
index 0000000..2a9220b
--- /dev/null
+++ b/Com/MusicMeetsComics/App.hs
@@ -0,0 +1,748 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE DataKinds         #-}
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TypeFamilies      #-}
+{-# LANGUAGE TypeOperators     #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+module Com.MusicMeetsComics.App where
+
+import qualified Clay
+import qualified Com.MusicMeetsComics.Assets as Assets
+import           Com.MusicMeetsComics.Look as Look
+import           Com.MusicMeetsComics.Look.Typography
+import           Com.Simatime.Alpha
+import           Com.Simatime.Network
+import           Data.Aeson ( ToJSON(..)
+                            , FromJSON(..)
+                            , genericToJSON
+                            , genericParseJSON
+                            , defaultOptions
+                            )
+import qualified Data.List as List
+import qualified Data.List.Split as List
+import           Data.Proxy ( Proxy(..) )
+import           Data.String
+import           Data.String.Quote
+import           Data.Text ( Text, replace, toLower )
+import           GHC.Generics ( Generic )
+import qualified GHC.Show as Legacy
+import           Miso
+import qualified Miso (for_)
+import           Miso.String
+import           Protolude hiding (replace)
+import           Servant.API                    ( Capture
+                                                , URI(..)
+                                                , safeLink
+                                                , (:<|>)(..)
+                                                , (:>)
+                                                )
+import           Servant.Links ( linkURI )
+
+crossorigin_ :: MisoString -> Attribute action
+crossorigin_ = textProp "crossorigin"
+
+-- | The css id for controling music in the comic player.
+audioId :: MisoString
+audioId = "audioSource"
+
+-- | Like 'onClick' but prevents the default action from triggering. Use this to
+-- overide 'a_' links, for example.
+onPreventClick :: Action -> Attribute Action
+onPreventClick action =
+  onWithOptions Miso.defaultOptions { preventDefault = True }
+    "click" emptyDecoder (\() -> action)
+
+-- TODO: make ComicId a hashid https://hackage.haskell.org/package/hashids-1.0.2.4/docs/Web-Hashids.html
+type ComicId = String
+
+-- | Class for turning different string types to snakeCase.
+class CanSnakeCase str where
+   snake :: str -> str
+
+instance CanSnakeCase Text where
+    snake = Data.Text.replace " " "-" . Data.Text.toLower
+
+-- | Used for looking up images on S3, mostly
+comicSlug :: Comic -> Text
+comicSlug Comic{..} = snake comicName <> "-" <> comicIssue
+
+data Comic = Comic
+  { comicId :: ComicId
+  , comicPages :: Integer
+  , comicName :: Text
+  , comicIssue :: Text -- ^ Ideally this would be a dynamic number-like type
+  , comicDescription :: Text
+  } deriving (Show, Eq, Generic)
+
+instance ToJSON Comic where
+  toJSON = genericToJSON Data.Aeson.defaultOptions
+
+instance FromJSON Comic where
+  parseJSON = genericParseJSON Data.Aeson.defaultOptions
+
+-- | Class for rendering media objects in different ways.
+class IsMediaObject o where
+    -- | Render a thumbnail for use in a shelf, or otherwise.
+    thumbnail :: o -> View Action
+    -- | Render a featured banner.
+    feature :: o -> Library -> View Action
+    -- | Media info view
+    info :: o -> Library -> View Action
+
+instance IsMediaObject Comic where
+    thumbnail c@Comic{..} = li_ []
+        [ a_
+          [ class_ "comic grow clickable"
+          , id_ $ "comic-" <> ms comicId
+          , onClick $ SetMediaInfo $ Just c
+          ]
+          [ img_ [ src_ $ ms $ Assets.demo <> comicSlug c <> ".png" ]
+          , span_ [] [ text $ "Issue #" <> ms comicIssue ]
+          , span_ [] [ text $ ms comicName ]
+          ]
+        ]
+    feature comic lib = div_ [ id_ "featured-comic" ]
+        [ img_ [ id_ "featured-banner", src_ $ ms $ Assets.demo <> "feature-banner.png" ]
+        , div_ [ id_ "featured-content" ]
+          [ div_ [ class_ "hero-original", css wide ]
+            [ span_ [ css thicc ] [ text "Herø" ]
+            , span_ [ css euro ] [ text " Original" ]
+            ]
+          , div_ [ class_ "comic-logo" ]
+            [ img_ [ src_ $ ms $ Assets.demo <> comicSlug comic <> "-logo.png" ] ]
+          , div_ [ class_ "comic-action-menu" ] $ el <$> [ Watch comic, Read comic, Save comic lib ]
+          , p_ [ class_ "description" ]
+            [ text . ms $ comicDescription comic
+            ]
+          ]
+        ]
+    info c@Comic {..} lib = div_ [ class_ "media-info", css euro ]
+        [ div_ [ class_ "media-info-meta" ]
+            [ column [ img_ [ src_ $ ms $ Assets.demo <> "dmc-widethumb.png" ] ]
+            , column
+                [ span_ [ style_ title ] [ text $ ms comicName ]
+                , span_ [ style_ subtitle ] [ text $ "Issue #" <> ms comicIssue ]
+                , span_ [] [ text "Released: " ]
+                , span_ [] [ text $ "Pages: " <> ms (show comicPages :: String) ]
+                ]
+            ]
+        , div_ [ class_ "media-info-summary" ]
+            [ p_ [ style_ $ uppercase <> bold <> Look.expanded <> "font-size" =: ".8rem" ]
+                [ text "Summary" ]
+            , p_ [] [ text $ ms comicDescription ]
+            ]
+        , div_ [ class_ "media-info-actions" ] $ el <$> [ Save c lib, Read c, Watch c ]
+        -- , row [ text "credits" ]
+        ]
+        where
+            title = "color" =: "red" <> "font-size" =: "1.6rem" <> uppercase
+              <> "line-height" =: "100%" <> Look.condensed <> bold
+            subtitle = "color" =: "#fff" <> "font-size" =: "1.2rem" <> bold <> Look.condensed
+
+
+type ZoomModel = Int
+
+-- | All the buttons.
+data Button
+    = Watch Comic | Read Comic | Save Comic Library
+    | SaveIcon Comic Library
+    | ZoomIcon ZoomModel Comic Page
+    | PlayPause MisoString AudioState
+    | Arrow Action
+
+-- | Class for defining general, widely used elements in the heroverse.
+class Elemental v where el :: v -> View Action
+
+-- TODO: what if I just did this on all actions?
+-- then I could e.g. `el $ ToggleAudio audioId audioState`
+instance Elemental Button where
+    el (PlayPause id model) = button_
+        [ class_ "button is-large icon"
+        , onClick $ ToggleAudio id
+        ]
+        [ i_ [ class_ $ "fa " <> icon ][]]
+        where
+            icon = case model of
+                Paused -> "fa-play-circle"
+                Playing -> "fa-pause-circle"
+    el (Arrow act) = button_
+        [class_ "button is-large turn-page", onClick act]
+        [ img_ [src_ $ ms $ Assets.demo <> image <> ".png"]]
+        where image = case act of
+                  PrevPage -> "prev-page"
+                  NextPage -> "next-page"
+                  _ -> "prev-page"
+    el (Save c lib) =
+        if c `elem` lib then -- in library
+            a_ [ class_ $ "wrs-button saved", onClick $ ToggleInLibrary c ]
+            [ img_ [ src_ $ ms $ Assets.icon <> "save.svg" ]
+            , span_ [] [ text "saved" ]
+            ]
+        else -- not in library
+            a_ [ class_ $ "wrs-button", onClick $ ToggleInLibrary c ]
+            [ img_ [ src_ $ ms $ Assets.icon <> "save.svg" ]
+            , span_ [] [ text "save" ]
+            ]
+    el (SaveIcon c lib) =
+        if c `elem` lib then -- in library
+            button_
+            [ class_ "button is-large has-background-black"
+            , onClick $ ToggleInLibrary c
+            ]
+            [ img_ [ src_ $ ms $ Assets.demo <> "library-add.png" ] ]
+        else -- not in library
+            button_
+            [ class_ "button is-large has-background-black-bis"
+            , onClick $ ToggleInLibrary c
+            ]
+            [ img_ [ src_ $ ms $ Assets.demo <> "library-add.png" ] ]
+
+    el (ZoomIcon zmodel comic page) = button_
+          [ id_ "zoom-button", class_ "button is-large"
+          , onClick $ ToggleZoom comic page
+          ]
+          [ img_ [ src_ $ ms $ Assets.demo <> "zoom.png" ]
+          , input_
+            [ type_ "range", min_ "0", max_ "100", disabled_ True
+            , value_ $ ms (show zmodel :: String)
+            , class_ "ctrl", id_ "zoom"
+            ]
+          , label_
+            [ class_ "ctrl", Miso.for_ "zoom" ]
+            [ text $ ms $ (show zmodel :: String) ++ "%" ]
+          ]
+
+    el (Read c) = a_ [ class_ $ "wrs-button", onClick $ SelectExperience c ]
+        [ img_ [ src_ $ ms $ Assets.icon <> "read.svg" ]
+        , span_ [] [ text "read" ]
+        ]
+
+    el (Watch c) = a_ [ class_ $ "wrs-button", onClick $ StartWatching c ]
+        [ img_ [ src_ $ ms $ Assets.icon <> "watch.svg" ]
+        , span_ [] [ text "watch" ]
+        ]
+
+data AudioState = Playing | Paused
+    deriving (Show, Eq)
+
+type Library = [Comic]
+
+data ComicReaderState
+    = NotReading
+    | Cover ComicId
+    | ChooseExperience ComicId Page
+    | Reading ComicReaderView ComicId Page
+    | Watching ComicId
+    deriving (Show, Eq)
+
+findComic :: ComicId -> [Comic] -> Maybe Comic
+findComic id ls = List.find (\c -> comicId c == id) ls
+
+-- | Main model for the app.
+--
+-- Try to prefix component-specific state with the component initials: 'd' for
+-- discover, 'cp' for comic player.
+data Model = Model
+    { uri :: URI
+    , appComics :: RemoteData MisoString [Comic]
+    , userLibrary :: Library
+    , dMediaInfo :: Maybe Comic
+    , cpState :: ComicReaderState
+    , cpAudioState :: AudioState
+    , zoomModel :: ZoomModel
+    } deriving (Show, Eq)
+
+initModel :: URI -> Model
+initModel uri_ =
+  Model { uri = uri_
+        , appComics = NotAsked
+        , dMediaInfo = Nothing
+        , userLibrary = Protolude.empty
+        , cpState = detectPlayerState uri_
+        , cpAudioState = Paused
+        , zoomModel = 100
+        }
+
+-- | Hacky way to initialize the 'ComicReaderState' from the URI.
+detectPlayerState :: URI -> ComicReaderState
+detectPlayerState u = case List.splitOn "/" $ uriPath u of
+    ["", "comic", id, pg, "experience"] -> ChooseExperience id $ toPage pg
+    ["", "comic", id, _, "video"] -> Watching id
+    ["", "comic", id, pg, "full"] -> Reading Full id $ toPage pg
+    ["", "comic", id, pg] -> Reading Spread id $ toPage pg
+    ["", "comic", id] -> Cover id
+    _ -> NotReading
+  where
+    toPage pg = fromMaybe 1 (readMaybe pg :: Maybe Page)
+
+type Page = Int
+
+data Action
+  = NoOp
+  -- comic player stuff
+  | SelectExperience Comic
+  | StartReading Comic
+  | StartWatching Comic
+  | NextPage
+  | PrevPage
+  | ToggleZoom Comic Page
+  | ToggleAudio MisoString
+  | FetchComics
+  | SetComics (RemoteData MisoString [Comic])
+  | ToggleFullscreen
+  -- discover stuff
+  | SetMediaInfo (Maybe Comic)
+  | ToggleInLibrary Comic
+  -- app stuff
+  | ScrollIntoView MisoString
+  | HandleURI URI
+  | ChangeURI URI
+  | DumpModel
+  deriving (Show, Eq)
+
+type Discover = "discover" :> View Action
+
+type Home =
+    View Action
+
+type ComicCover =
+    "comic"
+    :> Capture "comicId" ComicId
+    :> View Action
+
+type ComicReaderSpread =
+    "comic"
+    :> Capture "id" ComicId
+    :> Capture "page" Page
+    :> View Action
+
+type ComicReaderFull =
+    "comic"
+    :> Capture "id" ComicId
+    :> Capture "page" Page
+    :> "full"
+    :> View Action
+
+type ComicVideo =
+    "comic"
+    :> Capture "id" ComicId
+    :> Capture "page" Page
+    :> "video"
+    :> View Action
+
+type ChooseExperience =
+    "comic"
+    :> Capture "id" ComicId
+    :> Capture "page" Page
+    :> "experience"
+    :> View Action
+
+type Login =
+    "login" :> View Action
+
+type ClientRoutes = Home
+    :<|> ComicCover :<|> ComicReaderSpread :<|> ComicReaderFull :<|> ComicVideo
+    :<|> Login :<|> Discover :<|> ChooseExperience
+
+handlers = home
+    :<|> comicCover :<|> comicPlayer :<|> comicPlayer :<|> comicPlayer
+    :<|> login :<|> discover :<|> comicPlayer
+
+routes :: Proxy ClientRoutes
+routes = Proxy
+
+comicPlayerSpreadProxy :: Proxy ComicReaderSpread
+comicPlayerSpreadProxy = Proxy
+
+comicPlayerFullProxy :: Proxy ComicReaderFull
+comicPlayerFullProxy = Proxy
+
+chooseExperienceProxy :: Proxy ChooseExperience
+chooseExperienceProxy = Proxy
+
+comicProxy :: Proxy ComicCover
+comicProxy = Proxy
+
+comicVideoProxy :: Proxy ComicVideo
+comicVideoProxy = Proxy
+
+homeProxy :: Proxy Home
+homeProxy = Proxy
+
+loginProxy :: Proxy Login
+loginProxy = Proxy
+
+discoverProxy :: Proxy Discover
+discoverProxy = Proxy
+
+home :: Model -> View Action
+home = login
+
+discover :: Model -> View Action
+discover model@(Model { userLibrary = lib}) = template "discover"
+  [ topbar
+  , main_ [id_ "app-body"] $ case appComics model of
+                               NotAsked -> undefined
+                               Loading -> [loading]
+                               Failure e -> undefined
+                               Success [] -> [nocomics]
+                               Success (comic:rest) ->
+                                 [ feature comic lib
+                                 , shelf "Recent Releases" (comic:rest)
+                                 , maybeView (flip info lib) $ dMediaInfo model
+                                 ]
+  , appmenu
+  , discoverFooter
+  ]
+
+-- | If 'View' had a 'Monoid' instance, then '(text "")' could just be 'mempty'
+maybeView :: (a -> View action) -> Maybe a -> View action
+maybeView f obj = maybe (text "") f obj
+
+mediaInfo :: Maybe Comic -> Library -> View Action
+mediaInfo Nothing _ = text ""
+mediaInfo (Just comic) lib = div_ [ class_ "media-info" ] [ info comic lib ]
+
+appmenu :: View Action
+appmenu = aside_ [ id_ "appmenu" ] $ btn /@ links
+  where
+      links = [ (discoverLink, "discover.svg", "discover")
+              , (homeLink, "save.svg", "library")
+              , (homeLink, "watch.svg", "videos")
+              , (comicLink "1", "read.svg", "comics")
+              , (homeLink, "listen.svg", "music")
+              ]
+      btn (lnk,img,label) = a_
+        [ class_ "button"
+        , onPreventClick $ ChangeURI $ lnk
+        ]
+        [ img_ [src_ $ ms $ Assets.icon <> img]
+        , span_ [] [ text label ]
+        ]
+
+-- TODO: make this a loading gif of some sort... maybe the hero icon filling from white to red
+loading :: View Action
+loading = div_ [ class_ "loading" ] [ text "Loading..." ]
+
+nocomics :: View Action
+nocomics = div_ [ class_ "loading" ] [ text "error: no comics found" ]
+
+shelf :: IsMediaObject o => MisoString -> [o] -> View Action
+shelf title comics = div_ [ class_ "shelf" ]
+    [ div_ [ class_ "shelf-head" ] [ text title ]
+    , ul_ [ class_ "shelf-body" ] $ thumbnail /@ comics
+    ]
+
+discoverFooter :: View Action
+discoverFooter = footer_
+  [ id_ "app-foot"
+  , class_ "is-black"
+  ]
+  [ div_
+    [id_ "app-foot-social", css euro]
+    [ div_ [class_ "row is-marginless"]
+      [ smallImg "facebook.png"  $ Just "https://www.facebook.com/musicmeetscomics"
+      , smallImg "twitter.png"   $ Just "https://twitter.com/musicmeetscomic"
+      , smallImg "instagram.png" $ Just "https://www.instagram.com/musicmeetscomics/"
+      , smallImg "spotify.png"   $ Just "https://open.spotify.com/user/i4ntfg6ganjgxdsylinigcjlq?si=ymWsSkwsT9iaLw2LeAJNNg"
+      , smallImg "youtube.png"   $ Just "https://www.youtube.com/channel/UCnNPLiuJ1ueo1KTPgHDE7lA/"
+      ]
+    , div_ [class_ "row"] [ text "Team | Contact Us | Privacy Policy" ]
+    ]
+  , div_
+    [ id_ "app-foot-quote", css euro ]
+    [ p_ [] [text "With great power comes great responsiblity."]
+    , p_ [] [text "-Stan Lee"]
+    ]
+  , div_
+    [ css euro, id_ "app-foot-logo", onClick DumpModel ]
+    [ a_ [ class_ "social-icon", href_ "#" ] [ img_ [ src_ $ ms $ Assets.icon <> "hero-logo.svg" ]]
+    , span_ [] [ text "© Com.MusicMeetsComics Records, Inc. All Rights Reserved" ]
+    ]
+  ]
+  where
+      attrs Nothing = [ class_ "social-icon" ]
+      attrs (Just lnk) = [ class_ "social-icon", href_ lnk, target_ "_blank" ]
+      smallImg x lnk = a_ (attrs lnk)
+        [ img_ [src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/" <> x ]]
+
+comicCover :: ComicId -> Model -> View Action
+comicCover comicId_ model = comicPlayer comicId_ 1 model
+
+data ComicReaderView = Spread | Full
+    deriving (Show, Eq)
+
+comicPlayer :: ComicId -> Page -> Model -> View Action
+comicPlayer _ _ model = case appComics model of
+    NotAsked -> undefined
+    Loading -> loading
+    Failure e -> undefined
+    Success comics -> case cpState model of
+        NotReading -> template "comic-player" [ text "error: not reading" ]
+        Cover id -> viewOr404 comics comicSpread id 1 model
+        ChooseExperience id pg ->
+            viewOr404 comics chooseExperiencePage id pg model
+        Reading Spread id pg -> viewOr404 comics comicSpread id pg model
+        Reading Full id pg -> viewOr404 comics zoomScreen id pg model
+        Watching id -> viewOr404 comics comicVideo id 0 model
+
+viewOr404 :: [Comic]
+          -> (Comic -> Page -> Model -> View Action)
+          -> ComicId -> Page -> Model -> View Action
+viewOr404 comics f id pg model =
+    case findComic id comics of
+      Just c  -> f c pg model
+      Nothing -> the404 model
+
+template :: MisoString -> [View Action] -> View Action
+template id rest = div_ [id_ id, class_ "app is-black"] rest
+
+closeButton :: View Action
+closeButton = a_ [ id_ "close-button", onClick $ ChangeURI discoverLink ]
+    [ text "x" ]
+
+zoomScreen :: Comic -> Page -> Model -> View Action
+zoomScreen comic page model = template "comic-player"
+  [ topbar
+  , main_
+    [id_ "app-body"]
+    [ img_
+        [ src_ comicImg
+        , class_ "comic-page-full"
+        ]
+    ]
+  , comicControls comic page model
+  ]
+ where
+  comicImg =
+      ms Assets.demo
+      <> ms (comicSlug comic)
+      <> "-"
+      <> padLeft page
+      <> ".png"
+
+comicSpread :: Comic -> Page -> Model -> View Action
+comicSpread comic page model = template "comic-player"
+  [ topbar
+  , main_
+    [id_ "app-body"]
+    [ div_
+        [class_ "comic-player"]
+        [ img_ [ src_ comicImgLeft, class_ "comic-page" ]
+        , img_ [ src_ comicImgRight, class_ "comic-page" ]
+        ]
+    , closeButton
+    ]
+  , appmenu
+  , comicControls comic page model
+  ]
+ where
+  comicImgLeft, comicImgRight :: MisoString
+  comicImgLeft =
+      ms Assets.demo
+      <> ms (comicSlug comic)
+      <> "-"
+      <> padLeft page
+      <> ".png"
+  comicImgRight =
+      ms Assets.demo
+      <> ms (comicSlug comic)
+      <> "-"
+      <> (padLeft $ 1 + page)
+      <> ".png"
+
+frameborder_ :: MisoString -> Attribute action
+frameborder_ = textProp "frameborder"
+
+allowfullscreen_ :: Bool -> Attribute action
+allowfullscreen_ = boolProp "allowfullscreen"
+
+comicVideo :: Comic -> Page -> Model -> View Action
+comicVideo _ _ _ = template "comic-player"
+    [ topbar
+    , main_
+      [ id_ "app-body" ]
+      [ div_ [class_ "comic-video"]
+        [ iframe_
+          [ src_ "//player.vimeo.com/video/325757560"
+          , frameborder_ "0"
+          , allowfullscreen_ True
+          ]
+          []
+        ]
+      ]
+    ]
+
+padLeft :: Int -> MisoString
+padLeft n | n < 10    = ms $ ("0" <> Legacy.show n)
+          | otherwise = ms $ Legacy.show n
+
+comicControls :: Comic -> Page -> Model -> View Action
+comicControls comic page model = footer_
+  [ id_ "app-foot", class_ "comic-controls" ]
+  [ div_
+    [ class_ "comic-nav-audio"
+    , css $ flexCenter ]
+    [ audio_
+      [id_ audioId, loop_ True, crossorigin_ "anonymous"]
+      [source_ [src_ $ ms $ Assets.demo <> "stars-instrumental.mp3"]]
+    , el $ PlayPause audioId $ cpAudioState model
+    , span_
+      [ css $ euro <> thicc <> smol <> wide ]
+      [ text "Experiencing: Original" ]
+    ]
+  , div_
+    [ class_ "comic-controls-pages", css euro ]
+    [ el $ Arrow $ PrevPage
+    , span_ [] [ text $ leftPage <> "-" <> rightPage <> " of " <> totalpages ]
+    , el $ Arrow $ NextPage
+    ]
+  , div_ [class_ "comic-controls-share"]
+      [ el $ SaveIcon comic $ userLibrary model
+      , el $ ZoomIcon (zoomModel model) comic page
+      , button_
+          [class_ "button icon is-large", onClick ToggleFullscreen]
+          [i_ [ class_ "fa fa-expand" ] []]
+      ]
+  ]
+  where
+    leftPage   = ms . Legacy.show $ page
+    rightPage  = ms . Legacy.show $ 1 + page
+    totalpages = ms . Legacy.show $ comicPages comic
+
+login :: Model -> View Action
+login _ = template "login"
+    [ div_ [ id_ "login-inner" ]
+      [ img_ [ class_ fadeIn
+             , src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/hero-large.png"
+             ]
+      , hr_ [class_ fadeIn]
+      , form_  [class_ fadeIn]
+          [ ctrl [class_ "input", type_ "email", placeholder_ "Email"]
+          , ctrl [class_ "input", type_ "password", placeholder_ "Password"]
+          , div_ [class_ "action", css euro]
+              [ div_ [class_ "checkbox remember-me"]
+                  [ input_ [type_ "checkbox"]
+                  , label_ [Miso.for_ "checkbox"] [text "Remember Me"]
+                  ]
+              , div_ [class_ "button is-black", onClick $ ChangeURI discoverLink]
+                  [ text "Login" ]
+              ]
+          ]
+      , hr_ [class_ fadeIn]
+      , p_ [ class_ $ "help " <> fadeIn ]
+          [ a_ [href_ "#"][text "Forgot your username or password?"]
+          , a_ [href_ "#"][text "Don't have an account? Sign Up"]
+          ]
+      , img_ [ id_ "hero-logo"
+             , class_ "blur-out"
+             , src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/success-her-image.png"
+             ]
+      ]
+    ]
+  where
+    fadeIn = "animated fadeIn delay-2s"
+    ctrl x = div_ [class_ "control"] [ input_ x ]
+
+chooseExperiencePage :: Comic -> Page -> Model -> View Action
+chooseExperiencePage comic page model = template "choose-experience"
+    [ topbar
+    , main_ [ id_ "app-body" ]
+      [ h2_ [] [ text "Choose Your Musical Experience" ]
+      , p_ [] [ text experienceBlurb ]
+      , ul_ [] $ li comic /@ experiences
+      ]
+    , appmenu
+    , comicControls comic page model
+    ]
+  where
+    li c (name, artist, track) = li_
+        [ onClick $ StartReading c ]
+        [ div_ []
+          [ img_ [ src_ $ ms $ Assets.demo <> name <> ".png" ]
+          , span_ [] [ text $ ms name ]
+          ]
+        , span_ [ css $ thicc ] [ text $ ms artist ]
+        , span_ [] [ text $ ms track ]
+        ]
+    experiences :: [(Text, Text, Text)]
+    experiences =
+        [ ("comedic", "RxGF", "Soft Reveal")
+        , ("dark", "Logan Henderson", "Speak of the Devil")
+        , ("original", "Mehcad Brooks", "Stars")
+        , ("energetic", "Skela", "What's wrong with me")
+        , ("dramatic", "Josh Jacobson", "Sideline")
+        ]
+
+
+experienceBlurb :: MisoString
+experienceBlurb = [s|
+As you enter the world of Hero, you will find that music and visual art have a
+symbiotic relationship that can only be experienced, not described. Here, choose
+the tonality of the experience you wish to adventure on, whether it's a comedic,
+dark, energetic or dramatic. Feeling indecisive? Let us navigate your journey
+with the original curated music for this piece of visual art.
+|]
+
+topbar :: View Action
+topbar = header_
+  [id_ "app-head", class_ "is-black", css euro]
+  [ a_
+      [class_ "button is-medium is-black", onClick $ ChangeURI homeLink]
+      [img_ [src_ $ ms $ Assets.icon <> "hero-logo.svg"]]
+  , div_
+    [id_ "app-head-right"]
+    [ button_ [class_ "button icon is-medium is-black"]
+              [i_ [class_ "fas fa-search" ] []]
+    , button_ [ class_ "button is-medium is-black is-size-7"
+              , css $ euro <> wide <> thicc
+              ]
+      [text "News"]
+    , span_ [ class_ "icon is-large" ]
+        [  i_ [ class_ "fas fa-user" ] []
+        ]
+    ]
+  ]
+
+row :: [View Action] -> View Action
+row = div_ [ css $ Clay.display Clay.flex <> Clay.flexDirection Clay.row ]
+
+column :: [View Action] -> View Action
+column = div_ [  css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column ]
+
+-- | Links
+
+comicLink :: ComicId -> URI
+comicLink comicId_ = linkURI $ safeLink routes comicProxy $ comicId_
+
+comicPlayerSpreadLink :: ComicId -> Page -> URI
+comicPlayerSpreadLink id page =
+  linkURI $ safeLink routes comicPlayerSpreadProxy id page
+
+comicPlayerFullLink :: ComicId -> Page -> URI
+comicPlayerFullLink id page =
+  linkURI $ safeLink routes comicPlayerFullProxy id page
+
+comicVideoLink :: ComicId -> Page -> URI
+comicVideoLink id page =
+  linkURI $ safeLink routes comicVideoProxy id page
+
+homeLink :: URI
+homeLink = linkURI $ safeLink routes homeProxy
+
+loginLink :: URI
+loginLink = linkURI $ safeLink routes loginProxy
+
+discoverLink :: URI
+discoverLink = linkURI $ safeLink routes discoverProxy
+
+the404 :: Model -> View Action
+the404 _ = template "404" [p_ [] [text "Not found"]]
+
+chooseExperienceLink :: ComicId -> Page -> URI
+chooseExperienceLink id page =
+    linkURI $ safeLink routes chooseExperienceProxy id page
diff --git a/Com/MusicMeetsComics/Assets.hs b/Com/MusicMeetsComics/Assets.hs
new file mode 100644
index 0000000..f4fabde
--- /dev/null
+++ b/Com/MusicMeetsComics/Assets.hs
@@ -0,0 +1,15 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+-- | A module to wrap the CDN and provide convient helper functions to assets.
+module Com.MusicMeetsComics.Assets where
+
+import           Protolude
+
+cdnEdge :: Text
+cdnEdge = "https://heroverse.sfo2.cdn.digitaloceanspaces.com"
+
+demo :: Text
+demo = cdnEdge <> "/old-assets/demo/"
+
+icon :: Text
+icon = cdnEdge <> "/icons/"
diff --git a/Com/MusicMeetsComics/Database.hs b/Com/MusicMeetsComics/Database.hs
new file mode 100644
index 0000000..8178e9a
--- /dev/null
+++ b/Com/MusicMeetsComics/Database.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Com.MusicMeetsComics.Database
+  (
+    ComicDB
+  , getComics
+  , load
+  ) where
+
+import           Com.MusicMeetsComics.App
+import           Data.Map ( Map )
+import qualified Data.Map as Map
+import           Dhall
+import           Protolude
+import           Servant ( Handler )
+
+type ComicDB = (Map ComicId Comic)
+
+instance Interpret Comic
+
+load :: IO ComicDB
+load = listToComicDB <$> input auto "./comic-database.dhall"
+
+listToComicDB :: [Comic] -> ComicDB
+listToComicDB ls = Map.fromList $ (,) <$> comicId <*> identity <$> ls
+
+getComics :: ComicDB -> Handler [Comic]
+getComics db = return $ Map.elems db
diff --git a/Com/MusicMeetsComics/Look.hs b/Com/MusicMeetsComics/Look.hs
new file mode 100644
index 0000000..f53955c
--- /dev/null
+++ b/Com/MusicMeetsComics/Look.hs
@@ -0,0 +1,567 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+-- | Styles
+--
+-- Eventually move make this mostly well-typed. Use this EDSL:
+-- http://fvisser.nl/clay/
+module Com.MusicMeetsComics.Look where
+
+import           Clay
+import qualified Clay.Flexbox as Flexbox
+import qualified Clay.Media as Media
+import qualified Clay.Render as Clay
+import qualified Clay.Stylesheet as Stylesheet
+import           Com.MusicMeetsComics.Look.Typography as Typo
+import qualified Data.Map as Map
+import qualified Data.Text.Lazy as L
+import           Miso (Attribute, (=:), style_)
+import           Miso.String (MisoString, toMisoString)
+import           Protolude hiding ((**), (&), rem)
+
+main :: Css
+main = do
+  -- bulma adjustments
+  input ? marginRight (px 10) <> marginBottom (px 10)
+  -- base
+  ".fixed" ? position fixed
+  ".clickable" ? clickable
+  ".row" ? do
+      display flex
+      alignItems center
+      justifyContent spaceBetween
+  a <> a # hover <> a # visited ? do
+      color white
+      textDecoration none
+  ".loading" ? do
+      display flex
+      justifyContent center
+      alignItems center
+      height $ vh 100
+      width $ vw 100
+  -- animations
+  ".grow" ? do
+      transition "all" (sec 0.2) easeInOut (sec 0.2)
+      ":hover" & transform (scale 1.1 1.1)
+  ".blur-out" ? do
+      position absolute
+      animation
+          "blur"
+          (sec 1)
+          easeInOut
+          (sec 1)
+          (iterationCount 1)
+          normal
+          forwards
+      keyframes "blur" [ (0,   Clay.filter $ blur (px 0))
+                       , (50,  Clay.filter $ blur (px 0))
+                       , (100, Clay.filter $ blur (px 10))
+                       ]
+  html <> body ? do
+      background nite
+      mobile $ do
+          overflowX hidden
+          width (vw 100)
+  -- general app wrapper stuf
+  ".app" ? do
+    display flex
+    justifyContent spaceBetween
+    alignItems stretch
+    flexDirection column
+    color white
+  "#hero-logo" ? zIndex (-1)
+  "#app-head" <> "#app-body" <> "#app-foot" ? flexGrow 1
+  "#app-head" <> "#app-foot" ? do
+      display flex
+      alignItems center
+      flexShrink 0
+      justifyContent spaceBetween
+      padding 0 (rem 2) 0 (rem 2)
+      width (pct 100)
+      height (px navbarHeight)
+      background nite
+      position fixed
+      zIndex 999
+  "#app-head" ? do
+      alignSelf flexStart
+      borderBottom solid (px 3) grai
+      wide
+      top (px 0)
+      mobile $ noBorder <> width (vw 100)
+  "#app-body" ? do
+      display flex
+      desktop $ width (vw 93)
+      alignContent center
+      alignItems flexStart
+      justifyContent flexStart
+      flexDirection column
+      flexShrink 0
+      padding (px 0) 0 0 0
+      marginY $ px 74
+      mobile $ flexDirection column
+  "#discover #app-body" ? do desktop $ marginLeft appmenuWidth
+  "#app-head-right" ? do
+      display flex
+      justifyContent spaceBetween
+      textTransform Clay.uppercase
+      thicc
+      alignItems center
+      width (px 200)
+  "#app-foot" ? do
+      alignSelf flexEnd
+      bottom (px 0)
+      mobile $ remove
+  "#app-foot-social" ? do
+      display flex
+      flexDirection column
+      alignSelf flexStart
+      ".social-icon" ? padding 0 (px 20) (px 10) 0
+  "#app-foot-logo" ? do
+      display flex
+      flexDirection column
+      alignItems flexEnd
+  "#app-foot-quote" ? do
+      textTransform Clay.uppercase
+      textAlign center
+      -- hide app-foot-quote when it gets crowded
+      query Clay.all [Media.maxDeviceWidth (px 800)] $
+          hide
+
+  -- login
+  "#login" ? do
+      -- TODO: next 3 lines can be DRYed up, methinks
+      display flex
+      justifyContent center
+      alignItems center
+      alignSelf center
+      height (vh 100)
+  "#login-inner" ? do
+      display flex
+      justifyContent center
+      alignItems center
+      flexDirection column
+      zIndex 1
+      height (vh 100)
+      width (px 400)
+      mobile $ width (vw 90)
+  "#login" ** ".help" ** a ? do
+      color white
+      display flex
+      alignItems center
+      flexDirection column
+  "#login" ** form <> "#login" ** hr ? do
+      width (pct 100)
+  "#login" ** hr ? border solid (px 1) grai
+  "#login" ** ".button" ? do
+      marginTop (px 10)
+      display inlineBlock
+      border solid (px 2) white
+  "#login" ** ".action" ? do
+      display flex
+      justifyContent spaceBetween
+      alignItems baseline
+
+  -- choose your experience
+  "#choose-experience" ** "#app-body" ? do
+      euro <> wide
+      flexCenter
+      width (pct 100)
+      desktop $ marginLeft appmenuWidth <> height (vh 90)
+      mobile $ marginX (rem 0) <> marginTop (rem 0) <> minHeight (vh 90)
+      h2 ? do
+          thicc <> wide <> smol <> lower <> coat 2
+          textAlign center
+          mobile $ coat 0.8
+      p ? do
+          thicc <> coat 0.8 <> textAlign center
+          maxWidth (px 900)
+          marginAll (rem 1)
+          mobile $ coat 0.6
+      ul ? do
+          display flex
+          flexDirection row
+          flexWrap Flexbox.wrap
+          justifyContent spaceAround
+          li ? do
+              width (px 111)
+              position relative
+              display flex
+              flexDirection column
+              textAlign center
+              mobile $ coat 0.6
+              coat 0.8 <> clickable
+              divv <? do
+                  position relative
+                  flexCenter
+                  flexDirection column
+                  span <? do
+                      position absolute
+                      width (pct 100)
+                      smol <> thicc
+
+
+
+  -- comic player
+  ".comic-player" ? marginAll auto
+  ".comic-page" <> ".comic-page-full" ? do
+      width auto
+      marginAll auto
+      transform (scale 1 1)
+  ".comic-page" ? height (vh 90)
+  let ccb = ".comic-controls" ** button
+  ccb <> ccb # hover ? do
+      background nite
+      borderColor nite
+      color white
+  ".comic-controls-pages" ? do
+      justifyContent center
+      alignItems center
+      display flex
+  ".comic-video" |> iframe ? do
+      position absolute
+      height (pct 93)
+      width (pct 100)
+  "#close-button" ? do
+      euro <> wide
+      position fixed
+      cursor pointer
+      let z = rem 1.8
+      fontSize z
+      lineHeight z
+      let m = 24 :: Double
+      top $ px $ navbarHeight + m
+      left $ px $ m
+      zIndex 999
+
+  -- zoom button and slider
+  "#zoom-button" ? do
+      position relative
+      let sliderY = 75
+      let sliderYY = 250
+      euro <> wide
+      input ? do
+          transform $ Clay.rotate (deg (-90))
+          margin 0 0 (px sliderYY) 0
+          position absolute
+          height $ px sliderY
+          width $ px 200
+          hide
+      label ? do
+          coat 0.9
+          marginBottom $ px $ 2*sliderYY
+          position absolute
+          hide
+      ":hover" & ".ctrl" ? visibility visible
+
+  -- discover
+  "#discover" ? do
+      alignItems flexStart
+      flexDirection column
+  ".media-info" ? do
+      padding (rem 2) 0 (rem 2) (rem 2)
+      margin  (rem 2) 0 (rem 2) (rem 2)
+      borderTop    solid (px 1) white
+      borderBottom solid (px 1) white
+      flexDirection row
+      display flex
+      alignItems center
+      justifyContent spaceBetween
+      mobile $ do
+          margin (rem 2) 0 (rem 2) 0
+          padding 0 0 0 (rem 0)
+          noBorder
+          width (vw 100)
+          flexDirection column
+  ".media-info-meta" ? do
+      Flexbox.flex 2 1 (px 0)
+      display flex
+      flexDirection row
+      divv # lastChild <? paddingLeft (rem 1)
+      mobile $ do
+          width (vw 90)     -- this line can be commented if you want to center the meta
+          img ? width (px 150)
+          order (-1)
+          Flexbox.flex 1 1 (auto)
+  ".media-info-summary" ? do
+      Flexbox.flex 2 1 (px 0)
+      paddingRight (rem 3)
+      mobile $ do
+          marginAll (rem 1)
+          padding 0 0 0 (rem 0)
+  ".media-info-actions" ? do
+      Flexbox.flex 1 1 (px 132)
+      maxWidth (px 132)
+      display flex
+      flexDirection column
+      justifyContent spaceAround
+      mobile $ do
+          maxWidth (vw 100)
+          flexDirection row
+          order (1)
+          flexBasis auto -- initial
+          height (px 50)
+
+  -- appmenu
+  "#appmenu" ? do
+      euro <> wide
+      fontVariant smallCaps
+      position fixed
+      height (pct 100)
+      display flex
+      justifyContent center
+      zIndex 99
+      alignContent center
+      alignItems center
+      flexDirection column
+      minWidth appmenuWidth
+      a ? do
+          display flex
+          flexDirection column
+          color white
+          background nite
+          borderColor nite
+      a |> img ? do
+          width (px 22)
+          height (px 22)
+      desktop $ a |> span ? remove
+      mobile $ do
+          order 2
+          flexDirection row
+          position fixed
+          bottom (px 0)
+          width (vw 100)
+          height (px 74)
+          background nite
+          justifyContent center
+          alignItems center
+          a |> span ? fontSize (rem 0.5)
+
+      button ? margin (rem 0.5) 0 (rem 0.5) 0
+
+  -- feature
+  "#featured-comic" ? do
+      display flex
+      flexDirection column
+      justifyContent center
+      Typo.euro
+      height (px 411)
+      mobile $ do
+          padding (px 0) 0 0 0
+          margin 0 0 (px 50) 0
+      after & do
+          display block
+          position relative
+          background $ linearGradient (straight sideTop)
+              [ (setA 0 nite, (pct 0))
+              , (nite, (pct 100)) ]
+          let h = 149
+          marginTop (px (-h))
+          -- without +1, the gradient is offset by 1 px in chrome
+          height (px (h+1))
+          content blank
+      ".hero-original" ? do
+          textTransform Clay.uppercase
+          fontSize (rem 1.2)
+      ".description" ? do
+          width (px 400)
+          mobile $ remove
+  "#featured-banner" ? do
+      position relative
+      minHeight (px 411)
+      minWidth (px 1214)
+      mobile $ marginLeft (px (-310))
+  "#featured-content" ? do
+      position absolute
+      width (pct 100)
+      zIndex 9
+      top (px 200) -- b/c Firefox & WebKit autocalc "top" differently
+      mobile $ do
+          marginTop (px 200)
+          alignItems center
+          display flex
+          flexDirection column
+          padding (rem 0.5) (rem 0.5) (rem 0.5) (rem 0.5)
+          width (vw 100)
+
+
+  -- buttons
+  "a.wrs-button" ? do -- the "watch/read/save" button
+      flexCenter
+      height (px  36)
+      width  (px 132)
+      border solid (px 2) white
+      rounded
+      color white
+      margin 0 (px 15) (rem 1) 0
+      fontSize (rem 0.8)
+      fontVariant smallCaps
+      euro <> thicc <> wide
+      mobile $ do
+          height (px  26)
+          width  (px 100)
+          margin 0 (px 5) 0 (px 5)
+          fontSize (rem 0.6)
+      let alive = backgroundColor hero <> borderColor hero <> color white
+      ":hover" & alive
+      ".saved" & alive
+      img ? do
+          marginRight (px 7)
+          height (px 15)
+          mobile $ height (px 10)
+
+  --
+  ".comic-action-menu" ? display flex <> justifyContent (JustifyContentValue "left")
+
+  -- shelving
+  ".shelf" ? do
+      display flex
+      flexDirection column
+      justifyContent flexStart
+      alignItems flexStart
+      mobile $ do
+          padding (rem 0.5) (rem 0.5) (rem 0.5) (rem 0.5)
+          width (vw 100)
+      ".comic" ? do
+          display flex
+          flexDirection column
+          justifyContent center
+          textAlign center
+          euro
+          maxWidth (px 110)
+          img ? do
+              marginBottom (rem 0.5)
+              minHeight (px 170)
+              minWidth (px 110)
+  ".shelf-head" ? do
+      width (pct 100)
+      margin (rem 1.5) 0 (rem 1.5) 0
+      borderBottom solid (px 1) white
+      padding (rem 0.5) 0 0.5 0
+      euro <> thicc
+  ".shelf-body" ? do
+      display flex
+      flexDirection row
+      justifyContent spaceBetween
+      width (vw 93)
+      alignItems baseline
+      li ? padding 0 (rem 0.5) 0 (rem 0.5)
+      overflowY visible
+      star ? overflowY visible
+      overflowX scroll
+      flexWrap Flexbox.nowrap
+      li <? do
+          margin 0 (rem 1) (rem 1) 0
+          Flexbox.flex 0 0 auto
+
+navbarHeight :: Double
+navbarHeight = 74
+
+---------------------------------------------------------------------------------
+-- utilities
+---------------------------------------------------------------------------------
+
+hide :: Css
+hide = visibility hidden
+
+remove :: Css
+remove = display none
+
+noBorder :: Css
+noBorder = border none 0 transparent
+
+mobile :: Css -> Css
+mobile = query Clay.all [Media.maxDeviceWidth (px 500)]
+
+desktop :: Css -> Css
+desktop = query Clay.all [Media.minDeviceWidth (px 500)]
+
+rounded :: Css
+rounded = borderRadius (px 30) (px 30) (px 30) (px 30)
+
+appmenuWidth :: Size LengthUnit
+appmenuWidth = (px 67)
+
+flexCenter :: Css
+flexCenter = do
+    display flex
+    justifyContent center
+    justifyItems center
+    alignContent center
+    alignItems center
+
+blank :: Content
+blank = stringContent ""
+
+divv :: Clay.Selector
+divv = Clay.div
+
+marginAll :: Size a -> Css
+marginAll x = margin x x x x
+
+marginX :: Size a -> Css
+marginX n = marginLeft n <> marginRight n
+
+marginY :: Size a -> Css
+marginY n = marginTop n <> marginBottom n
+
+clickable :: Css
+clickable = cursor pointer
+
+-- heroic colors ---------------------------------------------------------------
+
+hero :: Color
+hero = rgb 241  32  32 -- #f12020
+
+nite :: Color
+nite = rgb  10  10  10 -- #0a0a0a
+
+grai :: Color
+grai = rgb 221 221 221 -- #dddddd
+
+-- runtime (client) style stuff ------------------------------------------------
+
+-- | Put 'Clay.Css' into a Miso-compatible style property.
+--
+-- Allows us to use any amount of CSS written with Clay inlined in HTML or
+-- dynamically as JavaScript object properties. The implementation is a bit
+-- hacky, but works.
+css :: Clay.Css -> Attribute action
+css = Miso.style_ . Map.fromList . f . Clay.renderWith Clay.htmlInline []
+   where
+       f :: L.Text -> [(MisoString, MisoString)]
+       f t = L.splitOn ";" t
+           <&> L.splitOn ":"
+           <&> \(x:y) -> (toMisoString x, toMisoString $ L.intercalate ":" y)
+
+inlineCss :: Css -> MisoString
+inlineCss = toMisoString . render
+
+type Style = Map MisoString MisoString
+
+red :: MisoString
+red = "#f12020"
+
+bold :: Style
+bold = "font-weight" =: "bold"
+
+condensed :: Style
+condensed = "font-stretch" =: "condensed"
+
+expanded :: Style
+expanded = "font-stretch" =: "expanded"
+
+uppercase :: Style
+uppercase = "text-transform" =: "uppercase"
+
+---------------------------------------------------------------------------------
+-- upstream this to Clay
+---------------------------------------------------------------------------------
+
+
+newtype JustifyItemsValue = JustifyItemsValue Value
+  deriving (Val, Other, Inherit, Center, FlexEnd
+          , FlexStart, SpaceAround, SpaceBetween)
+
+justifyItems :: JustifyItemsValue -> Css
+justifyItems = Stylesheet.key "justify-items"
diff --git a/Com/MusicMeetsComics/Look/Typography.hs b/Com/MusicMeetsComics/Look/Typography.hs
new file mode 100644
index 0000000..91e157a
--- /dev/null
+++ b/Com/MusicMeetsComics/Look/Typography.hs
@@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Com.MusicMeetsComics.Look.Typography where
+
+import           Clay
+import           Clay.Stylesheet (key)
+import qualified Com.MusicMeetsComics.Assets as Assets
+import           Com.Simatime.Alpha
+import           Data.Semigroup ((<>))
+import           Protolude
+
+main :: Css
+main = fonts
+
+---------------------------------------------------------------------------------
+-- font modifiers
+---------------------------------------------------------------------------------
+
+euro, slim, wide, thicc, thinn, norm, lean,
+    smol, lower, upper :: Css
+
+euro  = fontFamily ["Eurostile"] [sansSerif]
+
+-- stretch
+slim  = fontStretch condensed
+wide  = fontStretch expanded
+
+-- weight
+thicc = fontWeight bold
+thinn = fontWeight normal
+
+-- style
+norm  = fontStyle normal
+lean  = fontStyle italic
+
+-- "smallcaps" is already taken by Clay
+smol  = fontVariant smallCaps
+
+lower = textTransform lowercase
+upper = textTransform uppercase
+
+---------------------------------------------------------------------------------
+-- font sizing
+---------------------------------------------------------------------------------
+
+-- | apparently "coat" is a synonym for "size"
+coat :: Double -> Css
+coat = fontSize . Clay.rem
+
+---------------------------------------------------------------------------------
+-- font faces
+---------------------------------------------------------------------------------
+
+fontRoot :: Text
+fontRoot = Assets.cdnEdge <> "/old-assets/fonts/eurostile/Eurostile"
+
+fonts :: Css
+fonts = mconcat $ mkEuro /@
+    [ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal)
+    , ("LTStd-Bold.otf", OpenType, thicc <> norm)
+    , ("LTStd-Cn.otf", OpenType, slim <> norm)
+    , ("LTStd-Ex2.otf", OpenType, wide <> norm)
+    , ("LTStd-BoldCn.otf", OpenType, slim <> thicc)
+    , ("LTStd-BoldEx2.otf", OpenType, wide <> thicc)
+    ]
+    where
+        mkEuro :: (Text, FontFaceFormat, Css) -> Css
+        mkEuro (sufx, fmt, extra) = fontFace $ do
+            fontFamily ["Eurostile"] []
+            fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) $ Just fmt]
+            extra
+
+
+---------------------------------------------------------------------------------
+-- TODO: add the below to Clay.Font upstream
+---------------------------------------------------------------------------------
+
+newtype FontStretch = FontStretch Value
+    deriving (Val, Inherit, Normal, Other)
+
+expanded :: FontStretch
+expanded = FontStretch "expanded"
+
+condensed :: FontStretch
+condensed = FontStretch "condensed"
+
+fontStretch :: FontStretch -> Css
+fontStretch = key "font-stretch"
diff --git a/Com/MusicMeetsComics/Server/Config.hs b/Com/MusicMeetsComics/Server/Config.hs
new file mode 100644
index 0000000..2bbfabc
--- /dev/null
+++ b/Com/MusicMeetsComics/Server/Config.hs
@@ -0,0 +1,131 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module Com.MusicMeetsComics.Server.Config where
+
+import           Com.MusicMeetsComics.Server.Logger
+import           Control.Concurrent (ThreadId)
+import           Control.Monad.Except (ExceptT, MonadError)
+import           Control.Monad.IO.Class
+import           Control.Monad.Logger (MonadLogger(..))
+import           Control.Monad.Metrics (Metrics, MonadMetrics, getMetrics)
+import qualified Control.Monad.Metrics as M
+import           Control.Monad.Reader (MonadIO, MonadReader, ReaderT, asks)
+import           Data.Text (pack)
+import           GHC.Base (String)
+import           Network.Wai (Middleware)
+import           Network.Wai.Handler.Warp (Port)
+import           Network.Wai.Middleware.RequestLogger (logStdout, logStdoutDev)
+import           Protolude
+import           Safe (readMay)
+import           Servant (ServantErr)
+import           System.Environment (lookupEnv)
+import           System.Remote.Monitoring (forkServer, serverMetricStore, serverThreadId)
+
+-- | This type represents the effects we want to have for our application.
+-- We wrap the standard Servant monad with 'ReaderT Config', which gives us
+-- access to the application configuration using the 'MonadReader'
+-- interface's 'ask' function.
+--
+-- By encapsulating the effects in our newtype, we can add layers to the
+-- monad stack without having to modify code that uses the current layout.
+newtype AppT m a = AppT
+  { runApp :: ReaderT Config (ExceptT ServantErr m) a
+  } deriving ( Functor
+             , Applicative
+             , Monad
+             , MonadReader Config
+             , MonadError ServantErr
+             , MonadIO
+             )
+
+type App = AppT IO
+
+-- | The Config for our application is (for now) the 'Environment' we're
+-- running in and a Persistent 'ConnectionPool'.
+data Config = Config
+  { configEnv :: Environment
+  , configMetrics :: Metrics
+  , configEkgServer :: ThreadId
+  , configLogEnv :: LogEnv
+  , configPort :: Port
+  }
+
+instance Monad m => MonadMetrics (AppT m) where
+  getMetrics = asks configMetrics
+
+-- | Katip instance for @AppT m@
+instance MonadIO m => Katip (AppT m) where
+  getLogEnv = asks configLogEnv
+  localLogEnv = panic "not implemented"
+
+-- | MonadLogger instance to use within @AppT m@
+instance MonadIO m => MonadLogger (AppT m) where
+  monadLoggerLog = adapt logMsg
+
+-- | MonadLogger instance to use in @makePool@
+instance MonadIO m => MonadLogger (KatipT m) where
+  monadLoggerLog = adapt logMsg
+
+-- | Right now, we're distinguishing between three environments. We could
+-- also add a @Staging@ environment if we needed to.
+data Environment
+  = Development
+  | Test
+  | Production
+  deriving (Eq, Show, Read)
+
+-- | This returns a 'Middleware' based on the environment that we're in.
+setLogger :: Environment -> Middleware
+setLogger Test = identity
+setLogger Development = logStdoutDev
+setLogger Production = logStdout
+
+-- | Web request logger (currently unimplemented and unused). For inspiration
+-- see ApacheLogger from wai-logger package.
+katipLogger :: LogEnv -> Middleware
+katipLogger env app req respond =
+  runKatipT env $ do
+    logMsg "web" InfoS "todo: received some request"
+    -- todo: log proper request data
+    liftIO $ app req respond
+
+-- | The number of pools to use for a given environment.
+envPool :: Environment -> Int
+envPool Test = 1
+envPool Development = 1
+envPool Production = 8
+
+-- | Allocates resources for 'Config'
+acquire :: IO Config
+acquire = do
+  port <- lookupSetting "PORT" 3001
+  env <- lookupSetting "ENV" Development
+  logEnv <- defaultLogEnv
+  ekgServer <- forkServer "localhost" 8000
+  let store = serverMetricStore ekgServer
+  metr <- M.initializeWith store
+  pure
+    Config
+      { configEnv = env
+      , configMetrics = metr
+      , configLogEnv = logEnv
+      , configPort = port
+      , configEkgServer = serverThreadId ekgServer
+      }
+
+-- | Looks up a setting in the environment, with a provided default, and
+-- 'read's that information into the inferred type.
+lookupSetting :: Read a => String -> a -> IO a
+lookupSetting env def_ = do
+  maybeValue <- lookupEnv env
+  case maybeValue of
+    Nothing  -> return def_
+    Just str -> maybe (handleFailedRead str) return (readMay str)
+ where
+  handleFailedRead str = panic
+    $ mconcat ["Failed to read [[", pack str, "]] for environment variable ", pack env]
diff --git a/Com/MusicMeetsComics/Server/Init.hs b/Com/MusicMeetsComics/Server/Init.hs
new file mode 100644
index 0000000..7ad3ebf
--- /dev/null
+++ b/Com/MusicMeetsComics/Server/Init.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Com.MusicMeetsComics.Server.Init where
+
+import qualified Com.MusicMeetsComics.Server.Config as Config
+import           Control.Concurrent (killThread)
+import           Control.Exception (bracket)
+import qualified Control.Monad.Metrics as M
+import qualified Katip
+import           Lens.Micro ((^.))
+import           Network.Wai (Application, Middleware)
+import           Network.Wai.Handler.Warp (run)
+import           Network.Wai.Metrics (metrics, registerWaiMetrics)
+import           Network.Wai.Middleware.Gzip
+import           Protolude
+import qualified System.IO as IO
+
+-- | An action that creates a WAI 'Application' together with its resources,
+--   runs it, and tears it down on exit
+runApp :: (Config.Config -> Application) -> IO ()
+runApp app = bracket Config.acquire shutdownApp jog
+  where
+    say = IO.hPutStrLn IO.stderr
+    jog config = do
+        say $ "hero"
+        say $ "port: " ++ show (Config.configPort config)
+        run (Config.configPort config) =<< initialize app config
+
+-- | The 'initialize' function accepts the required environment information,
+-- initializes the WAI 'Application' and returns it
+initialize :: (Config.Config -> Application) -> Config.Config -> IO Application
+initialize app cfg = do
+  waiMetrics <- registerWaiMetrics (Config.configMetrics cfg ^. M.metricsStore)
+  let logger = Config.setLogger (Config.configEnv cfg)
+  -- generateJavaScript
+  pure . logger . metrics waiMetrics . app $ cfg
+
+compress :: Middleware
+compress = gzip def { gzipFiles = GzipCompress }
+
+-- | Takes care of cleaning up 'Config.Config' resources
+shutdownApp :: Config.Config -> IO ()
+shutdownApp cfg = do
+  _ <- Katip.closeScribes (Config.configLogEnv cfg)
+    -- Monad.Metrics does not provide a function to destroy metrics store
+    -- so, it'll hopefully get torn down when async exception gets thrown
+    -- at metrics server process
+  killThread (Config.configEkgServer cfg)
+  pure ()
diff --git a/Com/MusicMeetsComics/Server/Logger.hs b/Com/MusicMeetsComics/Server/Logger.hs
new file mode 100644
index 0000000..eb37ef6
--- /dev/null
+++ b/Com/MusicMeetsComics/Server/Logger.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+module Com.MusicMeetsComics.Server.Logger
+  ( adapt
+  , defaultLogEnv
+  , logMsg
+  , runKatipT
+  , KatipT(..)
+  , Katip(..)
+  , LogEnv
+  , Severity(..)
+  ) where
+
+import           Control.Monad.Logger
+import qualified Control.Monad.Logger as Logger
+import           Katip
+import           Protolude
+import qualified System.IO as IO
+import qualified System.Log.FastLogger as FastLogger
+
+defaultLogEnv :: IO LogEnv
+defaultLogEnv = do
+  handleScribe <- mkHandleScribe ColorIfTerminal IO.stdout DebugS V2
+  env <- initLogEnv "hero" "production"
+  registerScribe "stdout" handleScribe defaultScribeSettings env
+
+fromLevel :: LogLevel -> Severity
+fromLevel LevelDebug = DebugS
+fromLevel LevelInfo = InfoS
+fromLevel LevelWarn = WarningS
+fromLevel LevelError = ErrorS
+fromLevel (LevelOther _) = NoticeS
+
+-- | Transforms Katip logMsg into monadLoggerLog to be used inside
+-- MonadLogger monad
+adapt ::
+     (ToLogStr msg, Applicative m, Katip m)
+  => (Namespace -> Severity -> Katip.LogStr -> m ())
+  -> Loc
+  -> LogSource
+  -> LogLevel
+  -> msg
+  -> m ()
+adapt f _ src lvl msg = f ns (fromLevel lvl) $ logStr' msg
+  where
+    ns = Namespace [src]
+    -- not sure how fast this is going to be
+    logStr' = Katip.logStr . FastLogger.fromLogStr . Logger.toLogStr