path: root/Com/MusicMeetsComics/App.hs

{-# 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 -> [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 "© 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 -> 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