diff options
Diffstat (limited to 'Hero/App.hs')
| -rw-r--r-- | Hero/App.hs | 939 |
1 files changed, 0 insertions, 939 deletions
diff --git a/Hero/App.hs b/Hero/App.hs deleted file mode 100644 index 6f7a8c4..0000000 --- a/Hero/App.hs +++ /dev/null @@ -1,939 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE NoImplicitPrelude #-} -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} - -module Hero.App where - -import Alpha -import qualified Clay -import Data.Aeson - ( FromJSON (..), - ToJSON (..), - defaultOptions, - genericParseJSON, - genericToJSON, - ) -import Data.Data (Data, Typeable) -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 qualified Hero.Assets as Assets -import Hero.Look as Look -import Hero.Look.Typography -import Miso -import qualified Miso (for_) -import Miso.Extend -import Miso.String -import Network.RemoteData -import Servant.API - ( (:<|>) (..), - (:>), - ) -import qualified Servant.API as Api -import Servant.Links (linkURI) - --- | The css id for controling music in the comic player. -audioId :: MisoString -audioId = "audioSource" - --- TODO: make ComicId a hashid --- https://hackage.haskell.org/package/hashids-1.0.2.4/docs/Web-Hashids.html -newtype ComicId - = ComicId String - deriving - ( Show, - Eq, - Ord, - Data, - Typeable, - Generic, - ToMisoString, - IsString, - Api.ToHttpApiData, - Api.FromHttpApiData - ) - -instance ToJSON ComicId where - toJSON = genericToJSON Data.Aeson.defaultOptions - -instance FromJSON ComicId where - parseJSON = genericParseJSON Data.Aeson.defaultOptions - --- | Used for looking up images on S3, mostly -comicSlug :: Comic -> Text -comicSlug Comic {..} = snake comicName <> "-" <> comicIssue - --- * user - -data User - = User - { userEmail :: Text, - userName :: Text, - userLibrary :: [Comic] - } - deriving (Show, Eq, Generic, Data, Ord) - -instance Semigroup User where - a <> b = - User - (userEmail a <> userEmail b) - (userName a <> userName b) - (userLibrary a <> userLibrary b) - -instance Monoid User where - mempty = User mempty mempty mempty - -instance ToJSON User where - toJSON = genericToJSON Data.Aeson.defaultOptions - -instance FromJSON User 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 -> User -> View Action - - -- | Media info view - info :: o -> User -> View Action - --- | How much to Zoom the comic image -type Magnification = Int - --- | All the buttons. -data Button - = Watch Comic - | Read Comic - | Save Comic User - | SaveIcon Comic User - | ZoomIcon Magnification 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 u) = - if c `elem` (userLibrary u) -- 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 - - a_ - [class_ "wrs-button", onClick $ ToggleInLibrary c] - [ img_ [src_ $ ms $ Assets.icon <> "save.svg"], - span_ [] [text "save"] - ] - el (SaveIcon c u) = - if c `elem` (userLibrary u) -- 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 - - 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) - -data ComicReaderState - = NotReading - | Cover ComicId - | ChooseExperience ComicId Page - | Reading ComicReaderView ComicId Page - | Watching ComicId - deriving (Show, Eq) - -findComic :: ComicId -> [Comic] -> Maybe Comic -findComic id = List.find (\c -> comicId c == id) - --- | 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 :: Api.URI, - appComics :: RemoteData MisoString [Comic], - user :: User, - dMediaInfo :: Maybe Comic, - cpState :: ComicReaderState, - cpAudioState :: AudioState, - magnification :: Magnification - } - deriving (Show, Eq) - -initModel :: Api.URI -> Model -initModel uri_ = - Model - { uri = uri_, - appComics = NotAsked, - dMediaInfo = Nothing, - user = mempty, - cpState = detectPlayerState uri_, - cpAudioState = Paused, - magnification = 100 - } - --- | Hacky way to initialize the 'ComicReaderState' from the Api.URI. -detectPlayerState :: Api.URI -> ComicReaderState -detectPlayerState u = case List.splitOn "/" $ Api.uriPath u of - ["", "comic", id, pg, "experience"] -> ChooseExperience (ComicId id) (toPage pg) - ["", "comic", id, _, "video"] -> Watching $ ComicId id - ["", "comic", id, pg, "full"] -> Reading Full (ComicId id) (toPage pg) - ["", "comic", id, pg] -> Reading Spread (ComicId id) (toPage pg) - ["", "comic", id] -> Cover $ ComicId 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 - | -- login - ValidateUserPassword - | -- app stuff - ScrollIntoView MisoString - | HandleURI Api.URI - | ChangeURI Api.URI - | DumpModel - deriving (Show, Eq) - -type AppRoutes = - ComicCover - :<|> ComicReaderSpread - :<|> ComicReaderFull - :<|> ComicVideo - :<|> Discover - :<|> ChooseExperience - -handlers = - comicCover - :<|> comicReader - :<|> comicReader - :<|> comicReader - :<|> discover - :<|> comicReader - -routes :: Proxy AppRoutes -routes = Proxy - -type PubRoutes = - Home - :<|> Login - -pubRoutes :: Proxy PubRoutes -pubRoutes = Proxy - --- * pages --- --- TODO: consider making a typeclass, something like: --- --- class Page name where --- type Route name :: View Action --- proxy :: Proxy name --- proxy = Proxy name --- view :: Model -> View Action --- link :: Api.URI - --- * home --- --- this is the unauthenticated page that you see when you first visit - -type Home = - View Action - -homeProxy :: Proxy Home -homeProxy = Proxy - -homeLink :: Api.URI -homeLink = linkURI $ Api.safeLink front homeProxy - where - front = Proxy :: Proxy Home - -home :: Model -> View Action -home = login - --- * login - -data LoginForm = LoginForm {loginEmail :: String, loginPass :: String} - deriving (Eq, Show, Read, Generic) - -instance ToJSON LoginForm - -instance FromJSON LoginForm - -type Login = - "login" :> View Action - -loginProxy :: Proxy Login -loginProxy = Proxy - -loginLink :: Api.URI -loginLink = linkURI $ Api.safeLink pubRoutes loginProxy - -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 [id_ "user", class_ "input", type_ "email", placeholder_ "Email"], - ctrl [id_ "pass", 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 ValidateUserPassword] - [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] - --- * discover - -type Discover = "discover" :> View Action - -discoverLink :: Api.URI -discoverLink = linkURI $ Api.safeLink routes discoverProxy - -discoverProxy :: Proxy Discover -discoverProxy = Proxy - -discover :: Model -> View Action -discover model@Model {user = u} = - template - "discover" - [ topbar, - main_ [id_ "app-body"] $ case appComics model of - NotAsked -> [loading] - Loading -> [loading] - Failure _ -> [nocomics] - Success [] -> [nocomics] - Success (comic : rest) -> - [ feature comic u, - shelf "Recent Releases" (comic : rest), - maybeView (`info` u) $ dMediaInfo model - ], - appmenu, - discoverFooter - ] - -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]] - --- * comic - -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, Data, Ord) - -instance ToJSON Comic where - toJSON = genericToJSON Data.Aeson.defaultOptions - -instance FromJSON Comic where - parseJSON = genericParseJSON Data.Aeson.defaultOptions - -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 ComicCover = - "comic" - :> Api.Capture "comicId" ComicId - :> View Action - -comicProxy :: Proxy ComicCover -comicProxy = Proxy - -comicCover :: ComicId -> Model -> View Action -comicCover comicId_ = comicReader comicId_ 1 - -comicLink :: ComicId -> Api.URI -comicLink comicId_ = linkURI $ Api.safeLink routes comicProxy comicId_ - --- * chooseExperience - -type ChooseExperience = - "comic" - :> Api.Capture "id" ComicId - :> Api.Capture "page" Page - :> "experience" - :> View Action - -chooseExperienceProxy :: Proxy ChooseExperience -chooseExperienceProxy = Proxy - -chooseExperienceLink :: ComicId -> Page -> Api.URI -chooseExperienceLink id page = - linkURI $ Api.safeLink routes chooseExperienceProxy id page - -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. -|] - --- * comicReader - -data ComicReaderView = Spread | Full - deriving (Show, Eq) - -comicReader :: ComicId -> Page -> Model -> View Action -comicReader _ _ 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 - -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" - --- * comicReaderSpread - -type ComicReaderSpread = - "comic" - :> Api.Capture "id" ComicId - :> Api.Capture "page" Page - :> View Action - -comicReaderSpreadProxy :: Proxy ComicReaderSpread -comicReaderSpreadProxy = Proxy - -comicReaderSpreadLink :: ComicId -> Page -> Api.URI -comicReaderSpreadLink id page = - linkURI $ Api.safeLink routes comicReaderSpreadProxy id page - -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" - -closeButton :: View Action -closeButton = - a_ - [id_ "close-button", onClick $ ChangeURI discoverLink] - [text "x"] - --- * comicReaderFull - -type ComicReaderFull = - "comic" - :> Api.Capture "id" ComicId - :> Api.Capture "page" Page - :> "full" - :> View Action - -comicReaderFullProxy :: Proxy ComicReaderFull -comicReaderFullProxy = Proxy - -comicReaderFullLink :: ComicId -> Page -> Api.URI -comicReaderFullLink id page = - linkURI $ Api.safeLink routes comicReaderFullProxy id page - --- * comicVideo - -type ComicVideo = - "comic" - :> Api.Capture "id" ComicId - :> Api.Capture "page" Page - :> "video" - :> View Action - -comicVideoProxy :: Proxy ComicVideo -comicVideoProxy = Proxy - -comicVideoLink :: ComicId -> Page -> Api.URI -comicVideoLink id page = - linkURI $ Api.safeLink routes comicVideoProxy id page - -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 - ] - [] - ] - ] - ] - --- * general page components & utils - --- | If 'View' had a 'Monoid' instance, then '(text "")' could just be 'mempty' -maybeView :: (a -> View action) -> Maybe a -> View action -maybeView = maybe (text "") - -mediaInfo :: Maybe Comic -> User -> View Action -mediaInfo Nothing _ = text "" -mediaInfo (Just comic) user = - div_ [class_ "media-info"] [info comic user] - -appmenu :: View Action -appmenu = aside_ [id_ "appmenu"] $ btn </ links - where - links = - -- these extra 'discoverLink's are just dummies - [ (discoverLink, "discover.svg", "discover"), - (discoverLink, "save.svg", "library"), - (discoverLink, "watch.svg", "videos"), - (comicLink "1", "read.svg", "comics"), - (discoverLink, "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 - ] - -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 = div_ [id_ id, class_ "app is-black"] - -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 $ user model, - el $ ZoomIcon (magnification 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 - -topbar :: View Action -topbar = - header_ - [id_ "app-head", class_ "is-black", css euro] - [ a_ - [ class_ "button is-medium is-black", - onClick $ ChangeURI discoverLink - ] - [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 -the404 :: Model -> View Action -the404 _ = template "404" [p_ [] [text "Not found"]] |