diff options
Diffstat (limited to 'Hero/App.hs')
| -rw-r--r-- | Hero/App.hs | 748 |
1 files changed, 748 insertions, 0 deletions
diff --git a/Hero/App.hs b/Hero/App.hs new file mode 100644 index 0000000..7f55052 --- /dev/null +++ b/Hero/App.hs @@ -0,0 +1,748 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +module Hero.App where + +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 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 Miso +import qualified Miso (for_) +import Miso.String +import Protolude hiding (replace) +import Servant.API ( Capture + , URI(..) + , safeLink + , (:<|>)(..) + , (:>) + ) +import Servant.Links ( linkURI ) + +crossorigin_ :: MisoString -> Attribute action +crossorigin_ = textProp "crossorigin" + +-- | The css id for controling music in the comic player. +audioId :: MisoString +audioId = "audioSource" + +-- | Like 'onClick' but prevents the default action from triggering. Use this to +-- overide 'a_' links, for example. +onPreventClick :: Action -> Attribute Action +onPreventClick 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 + +instance CanSnakeCase Text where + 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) + +instance ToJSON Comic where + toJSON = genericToJSON Data.Aeson.defaultOptions + +instance FromJSON Comic 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 -> 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 + ] + [ 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 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 + +-- | 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 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 (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) + +type Library = [Comic] + +data ComicReaderState + = 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 + +-- | 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 :: 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 + } + +-- | 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 + 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 + -- app stuff + | ScrollIntoView MisoString + | HandleURI URI + | ChangeURI URI + | 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 :<|> ComicReaderSpread :<|> ComicReaderFull :<|> ComicVideo + :<|> Login :<|> Discover :<|> ChooseExperience + +handlers = home + :<|> comicCover :<|> comicPlayer :<|> comicPlayer :<|> comicPlayer + :<|> login :<|> discover :<|> comicPlayer + +routes :: Proxy ClientRoutes +routes = Proxy + +comicPlayerSpreadProxy :: Proxy ComicReaderSpread +comicPlayerSpreadProxy = Proxy + +comicPlayerFullProxy :: Proxy ComicReaderFull +comicPlayerFullProxy = Proxy + +chooseExperienceProxy :: Proxy ChooseExperience +chooseExperienceProxy = Proxy + +comicProxy :: Proxy ComicCover +comicProxy = Proxy + +comicVideoProxy :: Proxy ComicVideo +comicVideoProxy = Proxy + +homeProxy :: Proxy Home +homeProxy = Proxy + +loginProxy :: Proxy Login +loginProxy = Proxy + +discoverProxy :: Proxy Discover +discoverProxy = Proxy + +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 + ] + +-- | If 'View' had a 'Monoid' instance, then '(text "")' could just be 'mempty' +maybeView :: (a -> View action) -> Maybe a -> View action +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 ] + +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_ + [ 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 ]] + +comicCover :: ComicId -> Model -> View Action +comicCover comicId_ model = comicPlayer comicId_ 1 model + +data ComicReaderView = Spread | Full + 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 +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 rest = div_ [id_ id, class_ "app is-black"] rest + +closeButton :: View Action +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" + ] + ] + , comicControls comic page model + ] + where + comicImg = + ms Assets.demo + <> 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 + ] + , 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" + +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 + ] + [] + ] + ] + ] + +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 $ 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 + 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_ + [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 ] + +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 |