diff options
Diffstat (limited to 'Hero/App.hs')
| -rw-r--r-- | Hero/App.hs | 1012 |
1 files changed, 558 insertions, 454 deletions
diff --git a/Hero/App.hs b/Hero/App.hs index 7f55052..6afcbd2 100644 --- a/Hero/App.hs +++ b/Hero/App.hs @@ -1,46 +1,48 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-missing-signatures #-} + module Hero.App where -import Alpha +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 Data.Aeson + ( FromJSON (..), + ToJSON (..), + defaultOptions, + genericParseJSON, + genericToJSON, + ) 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 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 Hero.Assets as Assets +import Hero.Look as Look +import Hero.Look.Typography +import Miso import qualified Miso (for_) -import Miso.String -import Protolude hiding (replace) -import Servant.API ( Capture - , URI(..) - , safeLink - , (:<|>)(..) - , (:>) - ) -import Servant.Links ( linkURI ) +import Miso.String +import Network.RemoteData +import Protolude hiding (replace) +import Servant.API + ( (:<|>) (..), + (:>), + Capture, + URI (..), + safeLink, + ) +import Servant.Links (linkURI) crossorigin_ :: MisoString -> Attribute action crossorigin_ = textProp "crossorigin" @@ -53,30 +55,36 @@ audioId = "audioSource" -- overide 'a_' links, for example. onPreventClick :: Action -> Attribute Action onPreventClick action = - onWithOptions Miso.defaultOptions { preventDefault = True } - "click" emptyDecoder (\() -> 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 + snake :: str -> str instance CanSnakeCase Text where - snake = Data.Text.replace " " "-" . Data.Text.toLower + 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) +comicSlug Comic {..} = snake comicName <> "-" <> comicIssue + +data Comic + = Comic + { comicId :: ComicId, + comicPages :: Integer, + comicName :: Text, + -- | Ideally this would be a dynamic number-like type + comicIssue :: Text, + comicDescription :: Text + } + deriving (Show, Eq, Generic) instance ToJSON Comic where toJSON = genericToJSON Data.Aeson.defaultOptions @@ -86,73 +94,93 @@ instance FromJSON Comic where -- | 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 + -- | 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 + 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 ] + [ 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 - ] + ] + 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 ] + ] + 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 - + ] + 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 + = 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 @@ -160,84 +188,100 @@ 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 (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 -- in library + then + a_ + [class_ $ "wrs-button saved", onClick $ ToggleInLibrary c] + [ img_ [src_ $ ms $ Assets.icon <> "save.svg"], + span_ [] [text "saved"] + ] + else-- not in library - el (ZoomIcon zmodel comic page) = button_ - [ id_ "zoom-button", class_ "button is-large" - , onClick $ ToggleZoom comic page + a_ + [class_ $ "wrs-button", onClick $ ToggleInLibrary c] + [ img_ [src_ $ ms $ Assets.icon <> "save.svg"], + span_ [] [text "save"] ] - [ 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 (SaveIcon c lib) = + if c `elem` lib -- in library + then + button_ + [ class_ "button is-large has-background-black", + onClick $ ToggleInLibrary c ] + [img_ [src_ $ ms $ Assets.demo <> "library-add.png"]] + else-- not in library - 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" ] - ] + 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) + deriving (Show, Eq) type Library = [Comic] data ComicReaderState - = NotReading - | Cover ComicId - | ChooseExperience ComicId Page - | Reading ComicReaderView ComicId Page - | Watching ComicId - deriving (Show, Eq) + = 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 @@ -246,36 +290,39 @@ findComic id ls = List.find (\c -> comicId c == id) ls -- -- 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) +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 - } + 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 + ["", "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) @@ -283,8 +330,8 @@ type Page = Int data Action = NoOp - -- comic player stuff - | SelectExperience Comic + | -- comic player stuff + SelectExperience Comic | StartReading Comic | StartWatching Comic | NextPage @@ -294,11 +341,11 @@ data Action | FetchComics | SetComics (RemoteData MisoString [Comic]) | ToggleFullscreen - -- discover stuff - | SetMediaInfo (Maybe Comic) + | -- discover stuff + SetMediaInfo (Maybe Comic) | ToggleInLibrary Comic - -- app stuff - | ScrollIntoView MisoString + | -- app stuff + ScrollIntoView MisoString | HandleURI URI | ChangeURI URI | DumpModel @@ -307,50 +354,62 @@ data Action type Discover = "discover" :> View Action type Home = - View Action + View Action type ComicCover = - "comic" + "comic" :> Capture "comicId" ComicId :> View Action type ComicReaderSpread = - "comic" + "comic" :> Capture "id" ComicId :> Capture "page" Page :> View Action type ComicReaderFull = - "comic" + "comic" :> Capture "id" ComicId :> Capture "page" Page :> "full" :> View Action type ComicVideo = - "comic" + "comic" :> Capture "id" ComicId :> Capture "page" Page :> "video" :> View Action type ChooseExperience = - "comic" + "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 + "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 @@ -383,21 +442,23 @@ 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 - ] +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 @@ -405,155 +466,173 @@ 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 ] +mediaInfo (Just comic) lib = div_ [class_ "media-info"] [info comic lib] appmenu :: View Action -appmenu = aside_ [ id_ "appmenu" ] $ btn </ links +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 + 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 ] + [ 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..." ] +loading = div_ [class_ "loading"] [text "Loading..."] nocomics :: View Action -nocomics = div_ [ class_ "loading" ] [ text "error: no comics found" ] +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 +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"] +discoverFooter = + footer_ + [ id_ "app-foot", + class_ "is-black" ] - , 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" ] + [ 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 ]] + 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) + 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 + 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 + 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" ] +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" - ] +zoomScreen comic page model = + template + "comic-player" + [ topbar, + main_ + [id_ "app-body"] + [ img_ + [ src_ comicImg, + class_ "comic-page-full" + ] + ], + comicControls comic page model ] - , comicControls comic page model - ] - where - comicImg = + where + comicImg = ms Assets.demo - <> ms (comicSlug comic) - <> "-" - <> padLeft page - <> ".png" + <> 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 +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 ] - , appmenu - , comicControls comic page model - ] - where - comicImgLeft, comicImgRight :: MisoString - comicImgLeft = + where + comicImgLeft, comicImgRight :: MisoString + comicImgLeft = ms Assets.demo - <> ms (comicSlug comic) - <> "-" - <> padLeft page - <> ".png" - comicImgRight = + <> ms (comicSlug comic) + <> "-" + <> padLeft page + <> ".png" + comicImgRight = ms Assets.demo - <> ms (comicSlug comic) - <> "-" - <> (padLeft $ 1 + page) - <> ".png" + <> ms (comicSlug comic) + <> "-" + <> (padLeft $ 1 + page) + <> ".png" frameborder_ :: MisoString -> Attribute action frameborder_ = textProp "frameborder" @@ -562,125 +641,147 @@ 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 - ] - [] +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 +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 +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"] []] + ] ] - , 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 + 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" - ] - ] +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 ] + 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 +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 ] + 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") - ] - + [ ("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| +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, @@ -689,33 +790,36 @@ 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" ] [] +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 ] +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 ] +column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column] -- | Links - comicLink :: ComicId -> URI comicLink comicId_ = linkURI $ safeLink routes comicProxy $ comicId_ @@ -745,4 +849,4 @@ the404 _ = template "404" [p_ [] [text "Not found"]] chooseExperienceLink :: ComicId -> Page -> URI chooseExperienceLink id page = - linkURI $ safeLink routes chooseExperienceProxy id page + linkURI $ safeLink routes chooseExperienceProxy id page |