summaryrefslogtreecommitdiff
path: root/Hero
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-07-26 19:09:55 -0700
committerBen Sima <ben@bsima.me>2020-10-13 11:36:15 -0400
commitdbea29d0c604c69968adbf658ca19a6cc207890d (patch)
treeefe7b0fd87b54a56cf096cc7bf4cfbfb836327c0 /Hero
parent6bb5a5872018ec047ce090e8b8f0db279ebe0991 (diff)
hero: renamings
Model -> Form Action -> Move Page -> PageNumber
Diffstat (limited to 'Hero')
-rw-r--r--Hero/Core.hs201
-rw-r--r--Hero/Host.hs43
-rw-r--r--Hero/Node.hs90
-rw-r--r--Hero/Part.hs3
4 files changed, 170 insertions, 167 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"]]
diff --git a/Hero/Host.hs b/Hero/Host.hs
index 5341cc6..87b9d33 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -10,6 +10,8 @@
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
+{-# OPTIONS_GHC -fno-warn-orphan #-}
+
-- | Hero web app
--
-- : exe mmc
@@ -54,7 +56,6 @@ import qualified Clay
import qualified Crypto.JOSE.JWK as Crypto
import Data.Acid (AcidState)
import qualified Data.Acid.Abstract as Acid
-import qualified Data.Aeson as Aeson
import Data.Text (Text)
import qualified Data.Text.Lazy as Lazy
import Hero.Core
@@ -164,7 +165,7 @@ instance Envy.DefConfig Config where
instance Envy.FromEnv Config
-- | Convert client side routes into server-side web handlers
-type AppHostRoutes = ToServerRoutes AppRoutes Templated Action
+type AppHostRoutes = ToServerRoutes AppRoutes Templated Move
-- | These are the main app handlers, and should require authentication.
appHostHandlers :: User -> Server AppHostRoutes
@@ -178,7 +179,7 @@ appHostHandlers _ =
:<|> chooseExperienceHandler
-- | Marketing pages
-type PubHostRoutes = ToServerRoutes PubRoutes Templated Action
+type PubHostRoutes = ToServerRoutes PubRoutes Templated Move
pubHostHandlers :: Server PubHostRoutes
pubHostHandlers =
@@ -193,7 +194,7 @@ wrapAuth ::
Auth.AuthResult user ->
route
wrapAuth f authResult = case authResult of
- Auth.Authenticated user -> f user
+ Auth.Authenticated u -> f u
Auth.BadPassword -> Auth.throwAll err401
Auth.NoSuchUser -> Auth.throwAll err406
Auth.Indefinite -> Auth.throwAll err422
@@ -355,7 +356,7 @@ handle404 _ respond =
$ toHtml
$ Templated
$ the404
- $ initModel homeLink
+ $ initForm homeLink
fontAwesomeRef :: MisoString
fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
@@ -371,31 +372,31 @@ bulmaRef :: MisoString
bulmaRef =
"https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css"
-homeHandler :: Handler (Templated (View Action))
-homeHandler = pure . Templated . home $ initModel homeLink
+homeHandler :: Handler (Templated (View Move))
+homeHandler = pure . Templated . home $ initForm homeLink
-comicCoverHandler :: ComicId -> Handler (Templated (View Action))
+comicCoverHandler :: ComicId -> Handler (Templated (View Move))
comicCoverHandler id =
- pure . Templated . comicCover id . initModel $ comicLink id
+ pure . Templated . comicCover id . initForm $ comicLink id
-comicPageHandler :: ComicId -> Page -> Handler (Templated (View Action))
+comicPageHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicPageHandler id n =
- pure . Templated . comicReader id n . initModel $ comicReaderSpreadLink id n
+ pure . Templated . comicReader id n . initForm $ comicReaderSpreadLink id n
-comicPageFullHandler :: ComicId -> Page -> Handler (Templated (View Action))
+comicPageFullHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicPageFullHandler id n =
- pure . Templated . comicReader id n . initModel $ comicReaderFullLink id n
+ pure . Templated . comicReader id n . initForm $ comicReaderFullLink id n
-comicVideoHandler :: ComicId -> Page -> Handler (Templated (View Action))
+comicVideoHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicVideoHandler id n =
- pure . Templated . comicReader id n . initModel $ comicVideoLink id n
+ pure . Templated . comicReader id n . initForm $ comicVideoLink id n
-discoverHandler :: Handler (Templated (View Action))
-discoverHandler = pure . Templated . discover $ initModel discoverLink
+discoverHandler :: Handler (Templated (View Move))
+discoverHandler = pure . Templated . discover $ initForm discoverLink
-chooseExperienceHandler :: ComicId -> Page -> Handler (Templated (View Action))
+chooseExperienceHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
chooseExperienceHandler id n =
- pure . Templated . comicReader id n . initModel $ chooseExperienceLink id n
+ pure . Templated . comicReader id n . initForm $ chooseExperienceLink id n
-loginHandler :: Handler (Templated (View Action))
-loginHandler = pure . Templated . login $ initModel loginLink
+loginHandler :: Handler (Templated (View Move))
+loginHandler = pure . Templated . login $ initForm loginLink
diff --git a/Hero/Node.hs b/Hero/Node.hs
index 55bc4b0..9934fd3 100644
--- a/Hero/Node.hs
+++ b/Hero/Node.hs
@@ -26,13 +26,13 @@ import qualified Data.Set as Set
import qualified GHC.Show as Legacy
import GHCJS.Types (JSVal)
import Hero.Core
- ( Action (..),
+ ( Move (..),
AudioState (..),
Comic (..),
ComicReaderState (..),
ComicReaderView (..),
LoginForm (..),
- Model (..),
+ Form (..),
User (..),
audioId,
chooseExperienceLink,
@@ -41,7 +41,7 @@ import Hero.Core
comicVideoLink,
discoverLink,
handlers,
- initModel,
+ initForm,
routes,
the404,
)
@@ -57,7 +57,7 @@ import Protolude
-- | Entry point for a miso application
main :: IO ()
-main = miso $ \currentURI -> App {model = initModel currentURI, ..}
+main = miso $ \currentURI -> App {model = initForm currentURI, ..}
where
update = move
view = see
@@ -73,18 +73,18 @@ main = miso $ \currentURI -> App {model = initModel currentURI, ..}
(∈) = Set.member
-- | Keyboard navigation - maps keys to actions.
-keynav :: Set Int -> Action
+keynav :: Set Int -> Move
keynav ks
| 37 ∈ ks = PrevPage -- ←
| 39 ∈ ks = NextPage -- →
- | 191 ∈ ks = DumpModel -- ?
+ | 191 ∈ ks = Dumpform -- ?
| 32 ∈ ks = ToggleAudio audioId -- SPC
| otherwise = NoOp
-see :: Model -> View Action
-see model =
- case runRoute routes handlers uri model of
- Left _ -> the404 model
+see :: Form -> View Move
+see form =
+ case runRoute routes handlers uri form of
+ Left _ -> the404 form
Right v -> v
-- | Console-logging
@@ -94,38 +94,38 @@ foreign import javascript unsafe "console.log($1);"
foreign import javascript unsafe "$1.value"
getValue :: JSVal -> IO MisoString
--- | Updates model, optionally introduces side effects
-move :: Action -> Model -> Effect Action Model
-move NoOp model = noEff model
-move DumpModel model = model <# do
- jslog $ ms $ Legacy.show model
+-- | Updates form, optionally introduces side effects
+move :: Move -> Form -> Effect Move Form
+move NoOp form = noEff form
+move Dumpform form = form <# do
+ jslog $ ms $ Legacy.show form
pure NoOp
-move (SelectExperience comic) model = model {cpState = ChooseExperience (comicId comic) 1}
+move (SelectExperience comic) form = form {cpState = ChooseExperience (comicId comic) 1}
<# do pure $ ChangeURI $ chooseExperienceLink (comicId comic) 1
-move (StartReading comic) model = model {cpState = Reading Spread (comicId comic) 1}
+move (StartReading comic) form = form {cpState = Reading Spread (comicId comic) 1}
<# do pure $ ChangeURI $ comicReaderSpreadLink (comicId comic) 1
-move (StartWatching comic) model = model {cpState = Watching (comicId comic)}
+move (StartWatching comic) form = form {cpState = Watching (comicId comic)}
<# do pure $ ChangeURI $ comicVideoLink (comicId comic) 1
-move NextPage model = case cpState model of
+move NextPage form = case cpState form of
Reading Spread id pg ->
- model {cpState = Reading Spread id (pg + 2)} <# do
+ form {cpState = Reading Spread id (pg + 2)} <# do
pure $ ChangeURI $ comicReaderSpreadLink id (pg + 2)
Reading Full id pg ->
- model {cpState = Reading Full id (pg + 1)} <# do
+ form {cpState = Reading Full id (pg + 1)} <# do
pure $ ChangeURI $ comicReaderFullLink id (pg + 1)
Cover id ->
- model {cpState = Reading Spread id 1} <# do
+ form {cpState = Reading Spread id 1} <# do
pure $ ChangeURI $ comicReaderSpreadLink id 1
- _ -> noEff model
-move PrevPage model = case cpState model of
+ _ -> noEff form
+move PrevPage form = case cpState form of
Reading Spread id pg ->
- model {cpState = Reading Spread id (pg -2)} <# do
+ form {cpState = Reading Spread id (pg -2)} <# do
pure $ ChangeURI $ comicReaderSpreadLink id (pg -2)
Reading Full id pg ->
- model {cpState = Reading Full id (pg -1)} <# do
+ form {cpState = Reading Full id (pg -1)} <# do
pure $ ChangeURI $ comicReaderFullLink id (pg -1)
- Cover _ -> noEff model
- _ -> noEff model
+ Cover _ -> noEff form
+ _ -> noEff form
move (ToggleZoom c pg) m = m {cpState = newState} <# pure act
where
goto lnk = ChangeURI $ lnk (comicId c) pg
@@ -134,52 +134,52 @@ move (ToggleZoom c pg) m = m {cpState = newState} <# pure act
Reading Full _ _ -> (reading Spread, goto comicReaderSpreadLink)
Reading Spread _ _ -> (reading Full, goto comicReaderFullLink)
x -> (x, NoOp)
-move (ToggleInLibrary c) model = model {user = newUser} <# pure NoOp
+move (ToggleInLibrary c) form = form {user = newUser} <# pure NoOp
where
- newUser = (user model) {userLibrary = newLib}
+ newUser = (user form) {userLibrary = newLib}
newLib
- | c `elem` (userLibrary $ user model) =
- Protolude.filter (/= c) $ userLibrary $ user model
- | otherwise = c : (userLibrary $ user model)
-move (HandleURI u) model = model {uri = u} <# pure NoOp
-move (ChangeURI u) model = model <# do
+ | c `elem` (userLibrary $ user form) =
+ Protolude.filter (/= c) $ userLibrary $ user form
+ | otherwise = c : (userLibrary $ user form)
+move (HandleURI u) form = form {uri = u} <# pure NoOp
+move (ChangeURI u) form = form <# do
pushURI u
pure NoOp
-move FetchComics model = model <# (SetComics <$> fetchComics)
-move (SetComics cs) model = noEff model {appComics = cs}
-move (ToggleAudio i) model = model {cpAudioState = newState} <# do
+move FetchComics form = form <# (SetComics <$> fetchComics)
+move (SetComics cs) form = noEff form {appComics = cs}
+move (ToggleAudio i) form = form {cpAudioState = newState} <# do
el <- Document.getElementById i
toggle el
pure NoOp
where
- (newState, toggle) = case cpAudioState model of
+ (newState, toggle) = case cpAudioState form of
Playing -> (Paused, Audio.pause)
Paused -> (Playing, Audio.play)
-move ToggleFullscreen model = model {cpState = newState} <# do
+move ToggleFullscreen form = form {cpState = newState} <# do
el <- Document.querySelector "body"
-- TODO: check Document.fullscreenEnabled
-- https://developer.mozilla.org/en-US/docs/Web/API/Document/fullscreenEnabled
_ <- toggle el
pure NoOp
where
- (toggle, newState) = case cpState model of
+ (toggle, newState) = case cpState form of
Reading Full c n -> (const Fullscreen.exit, Reading Full c n)
Reading Spread c n -> (Fullscreen.request, Reading Spread c n)
-- otherwise, do nothing:
x -> (pure, x)
-move (SetMediaInfo x) model = model {dMediaInfo = x}
+move (SetMediaInfo x) form = form {dMediaInfo = x}
<# case x of
Just Comic {comicId = id} ->
pure $ ScrollIntoView $ "comic-" <> ms id
Nothing ->
pure NoOp
-move (ScrollIntoView id) model = model <# do
+move (ScrollIntoView id) form = form <# do
jslog $ ms $ Legacy.show id
scrollIntoView id
pure NoOp
-move ValidateUserPassword model =
+move ValidateUserPassword form =
batchEff
- model
+ form
[doLogin, pure FetchComics, pure <| ChangeURI discoverLink]
where
doLogin = do
diff --git a/Hero/Part.hs b/Hero/Part.hs
index e69de29..fb34fff 100644
--- a/Hero/Part.hs
+++ b/Hero/Part.hs
@@ -0,0 +1,3 @@
+module Hero.Part () where
+
+