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, 748 insertions, 0 deletions

diff --git a/Hero/App.hs b/Hero/App.hs
new file mode 100644
index 0000000..7f55052
--- /dev/null
+++ b/Hero/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 Hero.App where
+
+import           Alpha
+import qualified Clay
+import qualified Hero.Assets as Assets
+import           Hero.Look as Look
+import           Hero.Look.Typography
+import           Network.RemoteData
+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 -> [loading]
+                               Loading -> [loading]
+                               Failure _ -> [nocomics]
+                               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 "© Hero 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 -> loading
+    Loading -> loading
+    Failure _ -> nocomics
+    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