summaryrefslogtreecommitdiff
path: root/Com/MusicMeetsComics/App.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Com/MusicMeetsComics/App.hs')
-rw-r--r--Com/MusicMeetsComics/App.hs748
1 files changed, 748 insertions, 0 deletions
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-01 08:21:35 +0000