diff options
author | Ben Sima <ben@bsima.me> | 2022-07-18 22:09:58 -0400 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2022-07-19 09:22:58 -0400 |
commit | bc9e5b0ea863a17537987faa5a72b00efc7767d1 (patch) | |
tree | a22df5a00c29f5612a5f6885b9e6bb9a7a56d420 /Hero/Core.hs | |
parent | f034ad709ba0de5a2e5ec6be47523f595e381d7a (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.hs | 939 |
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"]] |