diff options
Diffstat (limited to 'Hero/App.hs')
| -rw-r--r-- | Hero/App.hs | 520 |
1 files changed, 278 insertions, 242 deletions
diff --git a/Hero/App.hs b/Hero/App.hs index da2289c..418993d 100644 --- a/Hero/App.hs +++ b/Hero/App.hs @@ -395,46 +395,6 @@ data Action | DumpModel deriving (Show, Eq) -type Discover = "discover" :> View Action - -type Home = - View Action - -type ComicCover = - "comic" - :> Capture "comicId" ComicId - :> View Action - -type ComicReaderSpread = - "comic" - :> Capture "id" ComicId - :> Capture "page" Page - :> View Action - -type ComicReaderFull = - "comic" - :> Capture "id" ComicId - :> Capture "page" Page - :> "full" - :> View Action - -type ComicVideo = - "comic" - :> Capture "id" ComicId - :> Capture "page" Page - :> "video" - :> View Action - -type ChooseExperience = - "comic" - :> Capture "id" ComicId - :> Capture "page" Page - :> "experience" - :> View Action - -type Login = - "login" :> View Action - type ClientRoutes = Home :<|> ComicCover @@ -448,43 +408,106 @@ type ClientRoutes = handlers = home :<|> comicCover - :<|> comicPlayer - :<|> comicPlayer - :<|> comicPlayer + :<|> comicReader + :<|> comicReader + :<|> comicReader :<|> login :<|> discover - :<|> comicPlayer + :<|> comicReader routes :: Proxy ClientRoutes routes = Proxy -comicPlayerSpreadProxy :: Proxy ComicReaderSpread -comicPlayerSpreadProxy = Proxy - -comicPlayerFullProxy :: Proxy ComicReaderFull -comicPlayerFullProxy = Proxy - -chooseExperienceProxy :: Proxy ChooseExperience -chooseExperienceProxy = 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 :: URI -comicProxy :: Proxy ComicCover -comicProxy = Proxy +-- * home -comicVideoProxy :: Proxy ComicVideo -comicVideoProxy = Proxy +type Home = + View Action homeProxy :: Proxy Home homeProxy = Proxy +home :: Model -> View Action +home = login + +homeLink :: URI +homeLink = linkURI $ safeLink routes homeProxy + +-- * login + +type Login = + "login" :> View Action + loginProxy :: Proxy Login loginProxy = Proxy +loginLink :: URI +loginLink = linkURI $ safeLink routes 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 [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] + +-- * discover + +type Discover = "discover" :> View Action + +discoverLink :: URI +discoverLink = linkURI $ safeLink routes discoverProxy + discoverProxy :: Proxy Discover discoverProxy = Proxy -home :: Model -> View Action -home = login - discover :: Model -> View Action discover model@Model {user = u} = template @@ -504,49 +527,6 @@ discover model@Model {user = u} = discoverFooter ] --- | 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 = - [ (discoverLink, "discover.svg", "discover"), - (homeLink, "save.svg", "library"), - (homeLink, "watch.svg", "videos"), - (comicLink "1", "read.svg", "comics"), - (homeLink, "listen.svg", "music") - ] - btn (lnk, img, label) = - a_ - [ class_ "button", - onPreventClick $ ChangeURI lnk - ] - [ img_ [src_ $ ms $ Assets.icon <> img], - span_ [] [text label] - ] - --- TODO: make this a loading gif of some sort... maybe the hero icon filling from white to red -loading :: View Action -loading = div_ [class_ "loading"] [text "Loading..."] - -nocomics :: View Action -nocomics = div_ [class_ "loading"] [text "error: no comics found"] - -shelf :: IsMediaObject o => MisoString -> [o] -> View Action -shelf title comics = - div_ - [class_ "shelf"] - [ div_ [class_ "shelf-head"] [text title], - ul_ [class_ "shelf-body"] $ thumbnail </ comics - ] - discoverFooter :: View Action discoverFooter = footer_ @@ -584,14 +564,91 @@ discoverFooter = (attrs lnk) [img_ [src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/" <> x]] +-- * comic + +type ComicCover = + "comic" + :> Capture "comicId" ComicId + :> View Action + +comicProxy :: Proxy ComicCover +comicProxy = Proxy + comicCover :: ComicId -> Model -> View Action -comicCover comicId_ = comicPlayer comicId_ 1 +comicCover comicId_ = comicReader comicId_ 1 + +comicLink :: ComicId -> URI +comicLink comicId_ = linkURI $ safeLink routes comicProxy comicId_ + +-- * chooseExperience + +type ChooseExperience = + "comic" + :> Capture "id" ComicId + :> Capture "page" Page + :> "experience" + :> View Action + +chooseExperienceProxy :: Proxy ChooseExperience +chooseExperienceProxy = Proxy + +chooseExperienceLink :: ComicId -> Page -> URI +chooseExperienceLink id page = + linkURI $ 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) -comicPlayer :: ComicId -> Page -> Model -> View Action -comicPlayer _ _ model = case appComics model of +comicReader :: ComicId -> Page -> Model -> View Action +comicReader _ _ model = case appComics model of NotAsked -> loading Loading -> loading Failure _ -> nocomics @@ -604,27 +661,6 @@ comicPlayer _ _ model = case appComics model of Reading Full id pg -> viewOr404 comics zoomScreen id pg model Watching id -> viewOr404 comics comicVideo id 0 model -viewOr404 :: - [Comic] -> - (Comic -> Page -> Model -> View Action) -> - ComicId -> - Page -> - Model -> - View Action -viewOr404 comics f id pg model = - case findComic id comics of - Just c -> f c pg model - Nothing -> the404 model - -template :: MisoString -> [View Action] -> View Action -template id = div_ [id_ id, class_ "app is-black"] - -closeButton :: View Action -closeButton = - a_ - [id_ "close-button", onClick $ ChangeURI discoverLink] - [text "x"] - zoomScreen :: Comic -> Page -> Model -> View Action zoomScreen comic page model = template @@ -647,6 +683,22 @@ zoomScreen comic page model = <> padLeft page <> ".png" + +-- * comicReaderSpread + +type ComicReaderSpread = + "comic" + :> Capture "id" ComicId + :> Capture "page" Page + :> View Action + +comicReaderSpreadProxy :: Proxy ComicReaderSpread +comicReaderSpreadProxy = Proxy + +comicReaderSpreadLink :: ComicId -> Page -> URI +comicReaderSpreadLink id page = + linkURI $ safeLink routes comicReaderSpreadProxy id page + comicSpread :: Comic -> Page -> Model -> View Action comicSpread comic page model = template @@ -679,6 +731,44 @@ comicSpread comic page model = <> padLeft (1 + page) <> ".png" +closeButton :: View Action +closeButton = + a_ + [id_ "close-button", onClick $ ChangeURI discoverLink] + [text "x"] + +-- * comicReaderFull + +type ComicReaderFull = + "comic" + :> Capture "id" ComicId + :> Capture "page" Page + :> "full" + :> View Action + +comicReaderFullProxy :: Proxy ComicReaderFull +comicReaderFullProxy = Proxy + +comicReaderFullLink :: ComicId -> Page -> URI +comicReaderFullLink id page = + linkURI $ safeLink routes comicReaderFullProxy id page + +-- * comicVideo + +type ComicVideo = + "comic" + :> Capture "id" ComicId + :> Capture "page" Page + :> "video" + :> View Action + +comicVideoProxy :: Proxy ComicVideo +comicVideoProxy = Proxy + +comicVideoLink :: ComicId -> Page -> URI +comicVideoLink id page = + linkURI $ safeLink routes comicVideoProxy id page + frameborder_ :: MisoString -> Attribute action frameborder_ = textProp "frameborder" @@ -704,6 +794,68 @@ comicVideo _ _ _ = ] ] + +-- * 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 = + [ (discoverLink, "discover.svg", "discover"), + (homeLink, "save.svg", "library"), + (homeLink, "watch.svg", "videos"), + (comicLink "1", "read.svg", "comics"), + (homeLink, "listen.svg", "music") + ] + btn (lnk, img, label) = + a_ + [ class_ "button", + onPreventClick $ ChangeURI lnk + ] + [ img_ [src_ $ ms $ Assets.icon <> img], + span_ [] [text label] + ] + +-- TODO: make this a loading gif of some sort... maybe the hero icon filling +-- from white to red +loading :: View Action +loading = div_ [class_ "loading"] [text "Loading..."] + +nocomics :: View Action +nocomics = div_ [class_ "loading"] [text "error: no comics found"] + +shelf :: IsMediaObject o => MisoString -> [o] -> View Action +shelf title comics = + div_ + [class_ "shelf"] + [ div_ [class_ "shelf-head"] [text title], + ul_ [class_ "shelf-body"] $ thumbnail </ comics + ] + +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) @@ -745,95 +897,6 @@ comicControls comic page model = rightPage = ms . Legacy.show $ 1 + page totalpages = ms . Legacy.show $ comicPages comic -login :: Model -> View Action -login _ = - template - "login" - [ div_ - [id_ "login-inner"] - [ img_ - [ class_ fadeIn, - src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/hero-large.png" - ], - hr_ [class_ fadeIn], - form_ - [class_ fadeIn] - [ ctrl [class_ "input", type_ "email", placeholder_ "Email"], - ctrl [class_ "input", type_ "password", placeholder_ "Password"], - div_ - [class_ "action", css euro] - [ div_ - [class_ "checkbox remember-me"] - [ input_ [type_ "checkbox"], - label_ [Miso.for_ "checkbox"] [text "Remember Me"] - ], - div_ - [class_ "button is-black", onClick $ ChangeURI discoverLink] - [text "Login"] - ] - ], - hr_ [class_ fadeIn], - p_ - [class_ $ "help " <> fadeIn] - [ a_ [href_ "#"] [text "Forgot your username or password?"], - a_ [href_ "#"] [text "Don't have an account? Sign Up"] - ], - img_ - [ id_ "hero-logo", - class_ "blur-out", - src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/success-her-image.png" - ] - ] - ] - where - fadeIn = "animated fadeIn delay-2s" - ctrl x = div_ [class_ "control"] [input_ x] - -chooseExperiencePage :: Comic -> Page -> Model -> View Action -chooseExperiencePage comic page model = - template - "choose-experience" - [ topbar, - main_ - [id_ "app-body"] - [ h2_ [] [text "Choose Your Musical Experience"], - p_ [] [text experienceBlurb], - ul_ [] $ li comic </ experiences - ], - appmenu, - comicControls comic page model - ] - where - li c (name, artist, track) = - li_ - [onClick $ StartReading c] - [ div_ - [] - [ img_ [src_ $ ms $ Assets.demo <> name <> ".png"], - span_ [] [text $ ms name] - ], - span_ [css thicc] [text $ ms artist], - span_ [] [text $ ms track] - ] - experiences :: [(Text, Text, Text)] - experiences = - [ ("comedic", "RxGF", "Soft Reveal"), - ("dark", "Logan Henderson", "Speak of the Devil"), - ("original", "Mehcad Brooks", "Stars"), - ("energetic", "Skela", "What's wrong with me"), - ("dramatic", "Josh Jacobson", "Sideline") - ] - -experienceBlurb :: MisoString -experienceBlurb = - [s| -As you enter the world of Hero, you will find that music and visual art have a -symbiotic relationship that can only be experienced, not described. Here, choose -the tonality of the experience you wish to adventure on, whether it's a comedic, -dark, energetic or dramatic. Feeling indecisive? Let us navigate your journey -with the original curated music for this piece of visual art. -|] - topbar :: View Action topbar = header_ @@ -865,33 +928,6 @@ column :: [View Action] -> View Action column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column] -- | Links -comicLink :: ComicId -> URI -comicLink comicId_ = linkURI $ safeLink routes comicProxy comicId_ - -comicPlayerSpreadLink :: ComicId -> Page -> URI -comicPlayerSpreadLink id page = - linkURI $ safeLink routes comicPlayerSpreadProxy id page - -comicPlayerFullLink :: ComicId -> Page -> URI -comicPlayerFullLink id page = - linkURI $ safeLink routes comicPlayerFullProxy id page - -comicVideoLink :: ComicId -> Page -> URI -comicVideoLink id page = - linkURI $ safeLink routes comicVideoProxy id page - -homeLink :: URI -homeLink = linkURI $ safeLink routes homeProxy - -loginLink :: URI -loginLink = linkURI $ safeLink routes loginProxy - -discoverLink :: URI -discoverLink = linkURI $ safeLink routes discoverProxy the404 :: Model -> View Action the404 _ = template "404" [p_ [] [text "Not found"]] - -chooseExperienceLink :: ComicId -> Page -> URI -chooseExperienceLink id page = - linkURI $ safeLink routes chooseExperienceProxy id page |