diff options
Diffstat (limited to 'Hero/Host.hs')
| -rw-r--r-- | Hero/Host.hs | 43 |
1 files changed, 22 insertions, 21 deletions
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 |