diff options
Diffstat (limited to 'Hero/Core.hs')
| -rw-r--r-- | Hero/Core.hs | 201 |
1 files changed, 100 insertions, 101 deletions
diff --git a/Hero/Core.hs b/Hero/Core.hs index 9f67bd7..bc53503 100644 --- a/Hero/Core.hs +++ b/Hero/Core.hs @@ -25,9 +25,8 @@ 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 Data.Text (Text) import GHC.Generics (Generic) import qualified GHC.Show as Legacy import Hero.Look as Look @@ -105,13 +104,13 @@ instance FromJSON User where -- | 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 + thumbnail :: o -> View Move -- | Render a featured banner. - feature :: o -> User -> View Action + feature :: o -> User -> View Move -- | Media info view - info :: o -> User -> View Action + info :: o -> User -> View Move -- | How much to Zoom the comic image type Magnification = Int @@ -122,24 +121,24 @@ data Button | Read Comic | Save Comic User | SaveIcon Comic User - | ZoomIcon Magnification Comic Page + | ZoomIcon Magnification Comic PageNumber | PlayPause MisoString AudioState - | Arrow Action + | Arrow Move -- | Class for defining general, widely used elements in the heroverse. -class Elemental v where el :: v -> View Action +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 model) = + el (PlayPause id form) = button_ [ class_ "button is-large icon", onClick $ ToggleAudio id ] [i_ [class_ $ "fa " <> icon] []] where - icon = case model of + icon = case form of Paused -> "fa-play-circle" Playing -> "fa-pause-circle" el (Arrow act) = @@ -181,7 +180,7 @@ instance Elemental Button where onClick $ ToggleInLibrary c ] [img_ [src_ $ ms $ Pack.demo <> "library-add.png"]] - el (ZoomIcon zmodel comic page) = + el (ZoomIcon zform comic page) = button_ [ id_ "zoom-button", class_ "button is-large", @@ -193,13 +192,13 @@ instance Elemental Button where min_ "0", max_ "100", disabled_ True, - value_ $ ms (show zmodel :: String), + value_ $ ms (show zform :: String), class_ "ctrl", id_ "zoom" ], label_ [class_ "ctrl", Miso.for_ "zoom"] - [text $ ms $ (show zmodel :: String) ++ "%"] + [text $ ms $ (show zform :: String) ++ "%"] ] el (Read c) = a_ @@ -220,20 +219,20 @@ data AudioState = Playing | Paused data ComicReaderState = NotReading | Cover ComicId - | ChooseExperience ComicId Page - | Reading ComicReaderView ComicId Page + | 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 model for the app. +-- | Main form for the app. -- -- Try to prefix component-specific state with the component initials: 'd' for -- discover, 'cp' for comic player. -data Model - = Model +data Form + = Form { uri :: Api.URI, appComics :: RemoteData MisoString [Comic], user :: User, @@ -244,9 +243,9 @@ data Model } deriving (Show, Eq) -initModel :: Api.URI -> Model -initModel uri_ = - Model +initForm :: Api.URI -> Form +initForm uri_ = + Form { uri = uri_, appComics = NotAsked, dMediaInfo = Nothing, @@ -266,11 +265,11 @@ detectPlayerState u = case List.splitOn "/" $ Api.uriPath u of ["", "comic", id] -> Cover $ ComicId id _ -> NotReading where - toPage pg = fromMaybe 1 (readMaybe pg :: Maybe Page) + toPage pg = fromMaybe 1 (readMaybe pg :: Maybe PageNumber) -type Page = Int +type PageNumber = Int -data Action +data Move = NoOp | -- comic player stuff SelectExperience Comic @@ -278,7 +277,7 @@ data Action | StartWatching Comic | NextPage | PrevPage - | ToggleZoom Comic Page + | ToggleZoom Comic PageNumber | ToggleAudio MisoString | FetchComics | SetComics (RemoteData MisoString [Comic]) @@ -292,7 +291,7 @@ data Action ScrollIntoView MisoString | HandleURI Api.URI | ChangeURI Api.URI - | DumpModel + | Dumpform deriving (Show, Eq) type AppRoutes = @@ -328,18 +327,18 @@ pubRoutes = Proxy -- TODO: consider making a typeclass, something like: -- -- class Page name where --- type Route name :: View Action +-- type Route name :: View Move -- proxy :: Proxy name -- proxy = Proxy name --- view :: Model -> View Action +-- view :: form -> View Move -- link :: Api.URI --- * home +-- ** home -- -- this is the unauthenticated page that you see when you first visit type Home = - View Action + View Move homeProxy :: Proxy Home homeProxy = Proxy @@ -349,10 +348,10 @@ homeLink = linkURI $ Api.safeLink front homeProxy where front = Proxy :: Proxy Home -home :: Model -> View Action +home :: form -> View Move home = login --- * login +-- ** login data LoginForm = LoginForm {loginEmail :: String, loginPass :: String} deriving (Eq, Show, Read, Generic) @@ -362,7 +361,7 @@ instance ToJSON LoginForm instance FromJSON LoginForm type Login = - "login" :> View Action + "login" :> View Move loginProxy :: Proxy Login loginProxy = Proxy @@ -370,7 +369,7 @@ loginProxy = Proxy loginLink :: Api.URI loginLink = linkURI $ Api.safeLink pubRoutes loginProxy -login :: Model -> View Action +login :: form -> View Move login _ = template "login" @@ -414,9 +413,9 @@ login _ = fadeIn = "animated fadeIn delay-2s" ctrl x = div_ [class_ "control"] [input_ x] --- * discover +-- ** discover -type Discover = "discover" :> View Action +type Discover = "discover" :> View Move discoverLink :: Api.URI discoverLink = linkURI $ Api.safeLink routes discoverProxy @@ -424,12 +423,12 @@ discoverLink = linkURI $ Api.safeLink routes discoverProxy discoverProxy :: Proxy Discover discoverProxy = Proxy -discover :: Model -> View Action -discover model@Model {user = u} = +discover :: Form -> View Move +discover form@Form {user = u} = template "discover" [ topbar, - main_ [id_ "app-body"] $ case appComics model of + main_ [id_ "app-body"] $ case appComics form of NotAsked -> [loading] Loading -> [loading] Failure _ -> [nocomics] @@ -437,13 +436,13 @@ discover model@Model {user = u} = Success (comic : rest) -> [ feature comic u, shelf "Recent Releases" (comic : rest), - maybeView (`info` u) $ dMediaInfo model + maybeView (`info` u) $ dMediaInfo form ], appmenu, discoverFooter ] -discoverFooter :: View Action +discoverFooter :: View Move discoverFooter = footer_ [ id_ "app-foot", @@ -467,7 +466,7 @@ discoverFooter = p_ [] [text "-Stan Lee"] ], div_ - [css euro, id_ "app-foot-logo", onClick DumpModel] + [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"] ] @@ -480,7 +479,7 @@ discoverFooter = (attrs lnk) [img_ [src_ $ ms $ Pack.cdnEdge <> "/old-assets/images/icons/" <> x]] --- * comic +-- ** comic data Comic = Comic @@ -578,35 +577,35 @@ instance IsMediaObject Comic where type ComicCover = "comic" :> Api.Capture "comicId" ComicId - :> View Action + :> View Move comicProxy :: Proxy ComicCover comicProxy = Proxy -comicCover :: ComicId -> Model -> View Action +comicCover :: ComicId -> Form -> View Move comicCover comicId_ = comicReader comicId_ 1 comicLink :: ComicId -> Api.URI comicLink comicId_ = linkURI $ Api.safeLink routes comicProxy comicId_ --- * chooseExperience +-- ** chooseExperience type ChooseExperience = "comic" :> Api.Capture "id" ComicId - :> Api.Capture "page" Page + :> Api.Capture "page" PageNumber :> "experience" - :> View Action + :> View Move chooseExperienceProxy :: Proxy ChooseExperience chooseExperienceProxy = Proxy -chooseExperienceLink :: ComicId -> Page -> Api.URI +chooseExperienceLink :: ComicId -> PageNumber -> Api.URI chooseExperienceLink id page = linkURI $ Api.safeLink routes chooseExperienceProxy id page -chooseExperiencePage :: Comic -> Page -> Model -> View Action -chooseExperiencePage comic page model = +chooseExperiencePage :: Comic -> PageNumber -> Form -> View Move +chooseExperiencePage comic page form = template "choose-experience" [ topbar, @@ -617,7 +616,7 @@ chooseExperiencePage comic page model = ul_ [] $ li comic </ experiences ], appmenu, - comicControls comic page model + comicControls comic page form ] where li c (name, artist, track) = @@ -650,27 +649,27 @@ dark, energetic or dramatic. Feeling indecisive? Let us navigate your journey with the original curated music for this piece of visual art. |] --- * comicReader +-- ** comicReader data ComicReaderView = Spread | Full deriving (Show, Eq) -comicReader :: ComicId -> Page -> Model -> View Action -comicReader _ _ model = case appComics model of +comicReader :: ComicId -> PageNumber -> Form -> View Move +comicReader _ _ form = case appComics form of NotAsked -> loading Loading -> loading Failure _ -> nocomics - Success comics -> case cpState model of + Success comics -> case cpState form of NotReading -> template "comic-player" [text "error: not reading"] - Cover id -> viewOr404 comics comicSpread id 1 model + Cover id -> viewOr404 comics comicSpread id 1 form 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 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 -> Page -> Model -> View Action -zoomScreen comic page model = +zoomScreen :: Comic -> PageNumber -> Form -> View Move +zoomScreen comic page form = template "comic-player" [ topbar, @@ -681,7 +680,7 @@ zoomScreen comic page model = class_ "comic-page-full" ] ], - comicControls comic page model + comicControls comic page form ] where comicImg = @@ -691,23 +690,23 @@ zoomScreen comic page model = <> padLeft page <> ".png" --- * comicReaderSpread +-- ** comicReaderSpread type ComicReaderSpread = "comic" :> Api.Capture "id" ComicId - :> Api.Capture "page" Page - :> View Action + :> Api.Capture "page" PageNumber + :> View Move comicReaderSpreadProxy :: Proxy ComicReaderSpread comicReaderSpreadProxy = Proxy -comicReaderSpreadLink :: ComicId -> Page -> Api.URI +comicReaderSpreadLink :: ComicId -> PageNumber -> Api.URI comicReaderSpreadLink id page = linkURI $ Api.safeLink routes comicReaderSpreadProxy id page -comicSpread :: Comic -> Page -> Model -> View Action -comicSpread comic page model = +comicSpread :: Comic -> PageNumber -> Form -> View Move +comicSpread comic page form = template "comic-player" [ topbar, @@ -721,7 +720,7 @@ comicSpread comic page model = closeButton ], appmenu, - comicControls comic page model + comicControls comic page form ] where comicImgLeft, comicImgRight :: MisoString @@ -738,7 +737,7 @@ comicSpread comic page model = <> padLeft (1 + page) <> ".png" -closeButton :: View Action +closeButton :: View Move closeButton = a_ [id_ "close-button", onClick $ ChangeURI discoverLink] @@ -749,14 +748,14 @@ closeButton = type ComicReaderFull = "comic" :> Api.Capture "id" ComicId - :> Api.Capture "page" Page + :> Api.Capture "page" PageNumber :> "full" - :> View Action + :> View Move comicReaderFullProxy :: Proxy ComicReaderFull comicReaderFullProxy = Proxy -comicReaderFullLink :: ComicId -> Page -> Api.URI +comicReaderFullLink :: ComicId -> PageNumber -> Api.URI comicReaderFullLink id page = linkURI $ Api.safeLink routes comicReaderFullProxy id page @@ -765,14 +764,14 @@ comicReaderFullLink id page = type ComicVideo = "comic" :> Api.Capture "id" ComicId - :> Api.Capture "page" Page + :> Api.Capture "page" PageNumber :> "video" - :> View Action + :> View Move comicVideoProxy :: Proxy ComicVideo comicVideoProxy = Proxy -comicVideoLink :: ComicId -> Page -> Api.URI +comicVideoLink :: ComicId -> PageNumber -> Api.URI comicVideoLink id page = linkURI $ Api.safeLink routes comicVideoProxy id page @@ -782,7 +781,7 @@ frameborder_ = textProp "frameborder" allowfullscreen_ :: Bool -> Attribute action allowfullscreen_ = boolProp "allowfullscreen" -comicVideo :: Comic -> Page -> Model -> View Action +comicVideo :: Comic -> PageNumber -> Form -> View Move comicVideo _ _ _ = template "comic-player" @@ -807,12 +806,12 @@ comicVideo _ _ _ = maybeView :: (a -> View action) -> Maybe a -> View action maybeView = maybe (text "") -mediaInfo :: Maybe Comic -> User -> View Action +mediaInfo :: Maybe Comic -> User -> View Move mediaInfo Nothing _ = text "" mediaInfo (Just comic) user = div_ [class_ "media-info"] [info comic user] -appmenu :: View Action +appmenu :: View Move appmenu = aside_ [id_ "appmenu"] $ btn </ links where links = @@ -834,13 +833,13 @@ appmenu = aside_ [id_ "appmenu"] $ btn </ links -- TODO: make this a loading gif of some sort... maybe the hero icon filling -- from white to red -loading :: View Action +loading :: View Move loading = div_ [class_ "loading"] [text "Loading..."] -nocomics :: View Action +nocomics :: View Move nocomics = div_ [class_ "loading"] [text "error: no comics found"] -shelf :: IsMediaObject o => MisoString -> [o] -> View Action +shelf :: IsMediaObject o => MisoString -> [o] -> View Move shelf title comics = div_ [class_ "shelf"] @@ -850,17 +849,17 @@ shelf title comics = viewOr404 :: [Comic] -> - (Comic -> Page -> Model -> View Action) -> + (Comic -> PageNumber -> form -> View Move) -> ComicId -> - Page -> - Model -> - View Action -viewOr404 comics f id pg model = + PageNumber -> + form -> + View Move +viewOr404 comics f id pg form = case findComic id comics of - Just c -> f c pg model - Nothing -> the404 model + Just c -> f c pg form + Nothing -> the404 form -template :: MisoString -> [View Action] -> View Action +template :: MisoString -> [View Move] -> View Move template id = div_ [id_ id, class_ "app is-black"] padLeft :: Int -> MisoString @@ -868,8 +867,8 @@ padLeft n | n < 10 = ms ("0" <> Legacy.show n) | otherwise = ms $ Legacy.show n -comicControls :: Comic -> Page -> Model -> View Action -comicControls comic page model = +comicControls :: Comic -> PageNumber -> Form -> View Move +comicControls comic page form = footer_ [id_ "app-foot", class_ "comic-controls"] [ div_ @@ -879,7 +878,7 @@ comicControls comic page model = [ audio_ [id_ audioId, loop_ True, crossorigin_ "anonymous"] [source_ [src_ $ ms $ Pack.demo <> "stars-instrumental.mp3"]], - el $ PlayPause audioId $ cpAudioState model, + el $ PlayPause audioId $ cpAudioState form, span_ [css $ euro <> thicc <> smol <> wide] [text "Experiencing: Original"] @@ -892,8 +891,8 @@ comicControls comic page model = ], div_ [class_ "comic-controls-share"] - [ el $ SaveIcon comic $ user model, - el $ ZoomIcon (magnification model) comic page, + [ el $ SaveIcon comic $ user form, + el $ ZoomIcon (magnification form) comic page, button_ [class_ "button icon is-large", onClick ToggleFullscreen] [i_ [class_ "fa fa-expand"] []] @@ -904,7 +903,7 @@ comicControls comic page model = rightPage = ms . Legacy.show $ 1 + page totalpages = ms . Legacy.show $ comicPages comic -topbar :: View Action +topbar :: View Move topbar = header_ [id_ "app-head", class_ "is-black", css euro] @@ -930,12 +929,12 @@ topbar = ] ] -row :: [View Action] -> View Action +row :: [View Move] -> View Move row = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.row] -column :: [View Action] -> View Action +column :: [View Move] -> View Move column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column] -- | Links -the404 :: Model -> View Action +the404 :: form -> View Move the404 _ = template "404" [p_ [] [text "Not found"]] |