summaryrefslogtreecommitdiff
path: root/Hero/Core.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2022-07-18 22:09:58 -0400
committerBen Sima <ben@bsima.me>2022-07-19 09:22:58 -0400
commitbc9e5b0ea863a17537987faa5a72b00efc7767d1 (patch)
treea22df5a00c29f5612a5f6885b9e6bb9a7a56d420 /Hero/Core.hs
parentf034ad709ba0de5a2e5ec6be47523f595e381d7a (diff)
Upgrade nixpkgs, ghc923
I ended up deleting miso, and consequently all files under Hero/ and Miso/, because I couldn't get miso to build with GHC 9.2. Other things: - Niv has been wrapped by Biz/Bild/Deps.hs, so I can extend it to my liking. - Apply-refact is gone because I couldn't get it to build. - Disabled python stuff.
Diffstat (limited to 'Hero/Core.hs')
-rw-r--r--Hero/Core.hs939
1 files changed, 0 insertions, 939 deletions
diff --git a/Hero/Core.hs b/Hero/Core.hs
deleted file mode 100644
index 86b0638..0000000
--- a/Hero/Core.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.Core 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.Quote
-import Data.Text (Text)
-import GHC.Generics (Generic)
-import qualified GHC.Show as Legacy
-import Hero.Look as Look
-import Hero.Look.Typography
-import qualified Hero.Pack as Pack
-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 Move
-
- -- | Render a featured banner.
- feature :: o -> User -> View Move
-
- -- | Media info view
- info :: o -> User -> View Move
-
--- | 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 PageNumber
- | PlayPause MisoString AudioState
- | Arrow Move
-
--- | Class for defining general, widely used elements in the heroverse.
-class Elemental v where el :: v -> View Move
-
--- 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 form) =
- button_
- [ class_ "button is-large icon",
- onClick <| ToggleAudio id
- ]
- [i_ [class_ <| "fa " <> icon] []]
- where
- icon = case form of
- Paused -> "fa-play-circle"
- Playing -> "fa-pause-circle"
- el (Arrow act) =
- button_
- [class_ "button is-large turn-page", onClick act]
- [img_ [src_ <| ms <| Pack.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 <| Pack.icon <> "save.svg"],
- span_ [] [text "saved"]
- ]
- else -- not in library
-
- a_
- [class_ "wrs-button", onClick <| ToggleInLibrary c]
- [ img_ [src_ <| ms <| Pack.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 <| Pack.demo <> "library-add.png"]]
- else -- not in library
-
- button_
- [ class_ "button is-large has-background-black-bis",
- onClick <| ToggleInLibrary c
- ]
- [img_ [src_ <| ms <| Pack.demo <> "library-add.png"]]
- el (ZoomIcon zform comic page) =
- button_
- [ id_ "zoom-button",
- class_ "button is-large",
- onClick <| ToggleZoom comic page
- ]
- [ img_ [src_ <| ms <| Pack.demo <> "zoom.png"],
- input_
- [ type_ "range",
- min_ "0",
- max_ "100",
- disabled_ True,
- value_ <| ms (show zform :: String),
- class_ "ctrl",
- id_ "zoom"
- ],
- label_
- [class_ "ctrl", Miso.for_ "zoom"]
- [text <| ms <| (show zform :: String) ++ "%"]
- ]
- el (Read c) =
- a_
- [class_ "wrs-button", onClick <| SelectExperience c]
- [ img_ [src_ <| ms <| Pack.icon <> "read.svg"],
- span_ [] [text "read"]
- ]
- el (Watch c) =
- a_
- [class_ "wrs-button", onClick <| StartWatching c]
- [ img_ [src_ <| ms <| Pack.icon <> "watch.svg"],
- span_ [] [text "watch"]
- ]
-
-data AudioState = Playing | Paused
- deriving (Show, Eq)
-
-data ComicReaderState
- = NotReading
- | Cover ComicId
- | ChooseExperience ComicId PageNumber
- | Reading ComicReaderView ComicId PageNumber
- | Watching ComicId
- deriving (Show, Eq)
-
-findComic :: ComicId -> [Comic] -> Maybe Comic
-findComic id = List.find (\c -> comicId c == id)
-
--- | Main form for the app.
---
--- Try to prefix component-specific state with the component initials: 'd' for
--- discover, 'cp' for comic player.
-data Form = Form
- { uri :: Api.URI,
- appComics :: RemoteData MisoString [Comic],
- user :: User,
- dMediaInfo :: Maybe Comic,
- cpState :: ComicReaderState,
- cpAudioState :: AudioState,
- magnification :: Magnification
- }
- deriving (Show, Eq)
-
-initForm :: Api.URI -> Form
-initForm uri_ =
- Form
- { 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 PageNumber)
-
-type PageNumber = Int
-
-data Move
- = NoOp
- | -- comic player stuff
- SelectExperience Comic
- | StartReading Comic
- | StartWatching Comic
- | NextPage
- | PrevPage
- | ToggleZoom Comic PageNumber
- | 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
- | Dumpform
- deriving (Show, Eq)
-
-type AppRoutes =
- Home
- :<|> ComicCover
- :<|> ComicReaderSpread
- :<|> ComicReaderFull
- :<|> ComicVideo
- :<|> Discover
- :<|> ChooseExperience
-
-handlers =
- home
- :<|> 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 Move
--- proxy :: Proxy name
--- proxy = Proxy name
--- view :: form -> View Move
--- link :: Api.URI
-
--- ** home
-
---
--- this is the unauthenticated page that you see when you first visit
-
-type Home =
- View Move
-
-homeProxy :: Proxy Home
-homeProxy = Proxy
-
-homeLink :: Api.URI
-homeLink = linkURI <| Api.safeLink front homeProxy
- where
- front = Proxy :: Proxy Home
-
-home :: form -> View Move
-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 Move
-
-loginProxy :: Proxy Login
-loginProxy = Proxy
-
-loginLink :: Api.URI
-loginLink = linkURI <| Api.safeLink pubRoutes loginProxy
-
-login :: form -> View Move
-login _ =
- template
- "login"
- [ div_
- [id_ "login-inner"]
- [ img_
- [ class_ fadeIn,
- src_ <| ms <| Pack.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 <| Pack.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 Move
-
-discoverLink :: Api.URI
-discoverLink = linkURI <| Api.safeLink routes discoverProxy
-
-discoverProxy :: Proxy Discover
-discoverProxy = Proxy
-
-discover :: Form -> View Move
-discover form@Form {user = u} =
- template
- "discover"
- [ topbar,
- main_ [id_ "app-body"] <| case appComics form of
- NotAsked -> [loading]
- Loading -> [loading]
- Failure _ -> [nocomics]
- Success [] -> [nocomics]
- Success (comic : rest) ->
- [ feature comic u,
- shelf "Recent Releases" (comic : rest),
- maybeView (`info` u) <| dMediaInfo form
- ],
- appmenu,
- discoverFooter
- ]
-
-discoverFooter :: View Move
-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 Dumpform]
- [ a_ [class_ "social-icon", href_ "#"] [img_ [src_ <| ms <| Pack.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 <| Pack.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 <| Pack.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 <| Pack.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
- <| Pack.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 <| Pack.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 Move
-
-comicProxy :: Proxy ComicCover
-comicProxy = Proxy
-
-comicCover :: ComicId -> Form -> View Move
-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" PageNumber
- :> "experience"
- :> View Move
-
-chooseExperienceProxy :: Proxy ChooseExperience
-chooseExperienceProxy = Proxy
-
-chooseExperienceLink :: ComicId -> PageNumber -> Api.URI
-chooseExperienceLink id page =
- linkURI <| Api.safeLink routes chooseExperienceProxy id page
-
-chooseExperiencePage :: Comic -> PageNumber -> Form -> View Move
-chooseExperiencePage comic page form =
- 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 form
- ]
- where
- li c (name, artist, track) =
- li_
- [onClick <| StartReading c]
- [ div_
- []
- [ img_ [src_ <| ms <| Pack.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 -> PageNumber -> Form -> View Move
-comicReader _ _ form = case appComics form of
- NotAsked -> loading
- Loading -> loading
- Failure _ -> nocomics
- Success comics -> case cpState form of
- NotReading -> template "comic-player" [text "error: not reading"]
- Cover id -> viewOr404 comics comicSpread id 1 form
- ChooseExperience id pg ->
- viewOr404 comics chooseExperiencePage id pg form
- Reading Spread id pg -> viewOr404 comics comicSpread id pg form
- Reading Full id pg -> viewOr404 comics zoomScreen id pg form
- Watching id -> viewOr404 comics comicVideo id 0 form
-
-zoomScreen :: Comic -> PageNumber -> Form -> View Move
-zoomScreen comic page form =
- template
- "comic-player"
- [ topbar,
- main_
- [id_ "app-body"]
- [ img_
- [ src_ comicImg,
- class_ "comic-page-full"
- ]
- ],
- comicControls comic page form
- ]
- where
- comicImg =
- ms Pack.demo
- <> ms (comicSlug comic)
- <> "-"
- <> padLeft page
- <> ".png"
-
--- ** comicReaderSpread
-
-type ComicReaderSpread =
- "comic"
- :> Api.Capture "id" ComicId
- :> Api.Capture "page" PageNumber
- :> View Move
-
-comicReaderSpreadProxy :: Proxy ComicReaderSpread
-comicReaderSpreadProxy = Proxy
-
-comicReaderSpreadLink :: ComicId -> PageNumber -> Api.URI
-comicReaderSpreadLink id page =
- linkURI <| Api.safeLink routes comicReaderSpreadProxy id page
-
-comicSpread :: Comic -> PageNumber -> Form -> View Move
-comicSpread comic page form =
- 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 form
- ]
- where
- comicImgLeft, comicImgRight :: MisoString
- comicImgLeft =
- ms Pack.demo
- <> ms (comicSlug comic)
- <> "-"
- <> padLeft page
- <> ".png"
- comicImgRight =
- ms Pack.demo
- <> ms (comicSlug comic)
- <> "-"
- <> padLeft (1 + page)
- <> ".png"
-
-closeButton :: View Move
-closeButton =
- a_
- [id_ "close-button", onClick <| ChangeURI discoverLink]
- [text "x"]
-
--- * comicReaderFull
-
-type ComicReaderFull =
- "comic"
- :> Api.Capture "id" ComicId
- :> Api.Capture "page" PageNumber
- :> "full"
- :> View Move
-
-comicReaderFullProxy :: Proxy ComicReaderFull
-comicReaderFullProxy = Proxy
-
-comicReaderFullLink :: ComicId -> PageNumber -> Api.URI
-comicReaderFullLink id page =
- linkURI <| Api.safeLink routes comicReaderFullProxy id page
-
--- * comicVideo
-
-type ComicVideo =
- "comic"
- :> Api.Capture "id" ComicId
- :> Api.Capture "page" PageNumber
- :> "video"
- :> View Move
-
-comicVideoProxy :: Proxy ComicVideo
-comicVideoProxy = Proxy
-
-comicVideoLink :: ComicId -> PageNumber -> 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 -> PageNumber -> Form -> View Move
-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 Move
-mediaInfo Nothing _ = text ""
-mediaInfo (Just comic) user =
- div_ [class_ "media-info"] [info comic user]
-
-appmenu :: View Move
-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 <| Pack.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 Move
-loading = div_ [class_ "loading"] [text "Loading..."]
-
-nocomics :: View Move
-nocomics = div_ [class_ "loading"] [text "error: no comics found"]
-
-shelf :: IsMediaObject o => MisoString -> [o] -> View Move
-shelf title comics =
- div_
- [class_ "shelf"]
- [ div_ [class_ "shelf-head"] [text title],
- ul_ [class_ "shelf-body"] <| thumbnail </ comics
- ]
-
-viewOr404 ::
- [Comic] ->
- (Comic -> PageNumber -> form -> View Move) ->
- ComicId ->
- PageNumber ->
- form ->
- View Move
-viewOr404 comics f id pg form =
- case findComic id comics of
- Just c -> f c pg form
- Nothing -> the404 form
-
-template :: MisoString -> [View Move] -> View Move
-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 -> PageNumber -> Form -> View Move
-comicControls comic page form =
- footer_
- [id_ "app-foot", class_ "comic-controls"]
- [ div_
- [ class_ "comic-nav-audio",
- css flexCenter
- ]
- [ audio_
- [id_ audioId, loop_ True, crossorigin_ "anonymous"]
- [source_ [src_ <| ms <| Pack.demo <> "stars-instrumental.mp3"]],
- el <| PlayPause audioId <| cpAudioState form,
- 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 form,
- el <| ZoomIcon (magnification form) 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 Move
-topbar =
- header_
- [id_ "app-head", class_ "is-black", css euro]
- [ a_
- [ class_ "button is-medium is-black",
- onClick <| ChangeURI discoverLink
- ]
- [img_ [src_ <| ms <| Pack.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 Move] -> View Move
-row = div_ [css <| Clay.display Clay.flex <> Clay.flexDirection Clay.row]
-
-column :: [View Move] -> View Move
-column = div_ [css <| Clay.display Clay.flex <> Clay.flexDirection Clay.column]
-
--- | Links
-the404 :: form -> View Move
-the404 _ = template "404" [p_ [] [text "Not found"]]