diff options
Diffstat (limited to 'Hero')
| -rw-r--r-- | Hero/App.hs | 38 | ||||
| -rw-r--r-- | Hero/Client.hs | 10 | ||||
| -rw-r--r-- | Hero/Database.hs | 2 | ||||
| -rw-r--r-- | Hero/Look.hs | 67 | ||||
| -rw-r--r-- | Hero/Server.hs | 8 |
5 files changed, 59 insertions, 66 deletions
diff --git a/Hero/App.hs b/Hero/App.hs index 6afcbd2..39cfa03 100644 --- a/Hero/App.hs +++ b/Hero/App.hs @@ -165,7 +165,7 @@ instance IsMediaObject Comic where title = "color" =: "red" <> "font-size" =: "1.6rem" <> uppercase <> "line-height" - =: "100%" + =: "100%" <> Look.condensed <> bold subtitle = "color" =: "#fff" <> "font-size" =: "1.2rem" <> bold <> Look.condensed @@ -211,14 +211,14 @@ instance Elemental Button where if c `elem` lib -- in library then a_ - [class_ $ "wrs-button saved", onClick $ ToggleInLibrary c] + [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] + [class_ "wrs-button", onClick $ ToggleInLibrary c] [ img_ [src_ $ ms $ Assets.icon <> "save.svg"], span_ [] [text "save"] ] @@ -259,13 +259,13 @@ instance Elemental Button where ] el (Read c) = a_ - [class_ $ "wrs-button", onClick $ SelectExperience c] + [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] + [class_ "wrs-button", onClick $ StartWatching c] [ img_ [src_ $ ms $ Assets.icon <> "watch.svg"], span_ [] [text "watch"] ] @@ -284,7 +284,7 @@ data ComicReaderState deriving (Show, Eq) findComic :: ComicId -> [Comic] -> Maybe Comic -findComic id ls = List.find (\c -> comicId c == id) ls +findComic id = List.find . \c -> comicId c == id -- | Main model for the app. -- @@ -442,7 +442,7 @@ home :: Model -> View Action home = login discover :: Model -> View Action -discover model@(Model {userLibrary = lib}) = +discover model@Model {userLibrary = lib} = template "discover" [ topbar, @@ -454,7 +454,7 @@ discover model@(Model {userLibrary = lib}) = Success (comic : rest) -> [ feature comic lib, shelf "Recent Releases" (comic : rest), - maybeView (flip info lib) $ dMediaInfo model + maybeView (`info` lib) $ dMediaInfo model ], appmenu, discoverFooter @@ -462,7 +462,7 @@ discover model@(Model {userLibrary = lib}) = -- | 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 +maybeView = maybe (text "") mediaInfo :: Maybe Comic -> Library -> View Action mediaInfo Nothing _ = text "" @@ -481,7 +481,7 @@ appmenu = aside_ [id_ "appmenu"] $ btn </ links btn (lnk, img, label) = a_ [ class_ "button", - onPreventClick $ ChangeURI $ lnk + onPreventClick $ ChangeURI lnk ] [ img_ [src_ $ ms $ Assets.icon <> img], span_ [] [text label] @@ -540,7 +540,7 @@ discoverFooter = [img_ [src_ $ ms $ Assets.cdnEdge <> "/old-assets/images/icons/" <> x]] comicCover :: ComicId -> Model -> View Action -comicCover comicId_ model = comicPlayer comicId_ 1 model +comicCover comicId_ = comicPlayer comicId_ 1 data ComicReaderView = Spread | Full deriving (Show, Eq) @@ -572,7 +572,7 @@ viewOr404 comics f id pg model = Nothing -> the404 model template :: MisoString -> [View Action] -> View Action -template id rest = div_ [id_ id, class_ "app is-black"] rest +template id = div_ [id_ id, class_ "app is-black"] closeButton :: View Action closeButton = @@ -631,7 +631,7 @@ comicSpread comic page model = ms Assets.demo <> ms (comicSlug comic) <> "-" - <> (padLeft $ 1 + page) + <> padLeft (1 + page) <> ".png" frameborder_ :: MisoString -> Attribute action @@ -661,7 +661,7 @@ comicVideo _ _ _ = padLeft :: Int -> MisoString padLeft n - | n < 10 = ms $ ("0" <> Legacy.show n) + | n < 10 = ms ("0" <> Legacy.show n) | otherwise = ms $ Legacy.show n comicControls :: Comic -> Page -> Model -> View Action @@ -670,7 +670,7 @@ comicControls comic page model = [id_ "app-foot", class_ "comic-controls"] [ div_ [ class_ "comic-nav-audio", - css $ flexCenter + css flexCenter ] [ audio_ [id_ audioId, loop_ True, crossorigin_ "anonymous"] @@ -682,9 +682,9 @@ comicControls comic page model = ], div_ [class_ "comic-controls-pages", css euro] - [ el $ Arrow $ PrevPage, + [ el $ Arrow PrevPage, span_ [] [text $ leftPage <> "-" <> rightPage <> " of " <> totalpages], - el $ Arrow $ NextPage + el $ Arrow NextPage ], div_ [class_ "comic-controls-share"] @@ -767,7 +767,7 @@ chooseExperiencePage comic page model = [ img_ [src_ $ ms $ Assets.demo <> name <> ".png"], span_ [] [text $ ms name] ], - span_ [css $ thicc] [text $ ms artist], + span_ [css thicc] [text $ ms artist], span_ [] [text $ ms track] ] experiences :: [(Text, Text, Text)] @@ -821,7 +821,7 @@ column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column] -- | Links comicLink :: ComicId -> URI -comicLink comicId_ = linkURI $ safeLink routes comicProxy $ comicId_ +comicLink comicId_ = linkURI $ safeLink routes comicProxy comicId_ comicPlayerSpreadLink :: ComicId -> Page -> URI comicPlayerSpreadLink id page = diff --git a/Hero/Client.hs b/Hero/Client.hs index 0472d48..a513dcd 100644 --- a/Hero/Client.hs +++ b/Hero/Client.hs @@ -122,7 +122,7 @@ move PrevPage model = case cpState model of pure $ ChangeURI $ comicPlayerFullLink id (pg -1) Cover _ -> noEff model _ -> noEff model -move (ToggleZoom c pg) m = m {cpState = newState} <# do pure act +move (ToggleZoom c pg) m = m {cpState = newState} <# pure act where goto lnk = ChangeURI $ lnk (comicId c) pg reading v = Reading v (comicId c) pg @@ -133,9 +133,9 @@ move (ToggleZoom c pg) m = m {cpState = newState} <# do pure act move (ToggleInLibrary c) model = model {userLibrary = newLib} <# pure NoOp where newLib - | c `elem` (userLibrary model) = + | c `elem` userLibrary model = Protolude.filter (/= c) $ userLibrary model - | otherwise = c : (userLibrary model) + | otherwise = c : userLibrary model move (HandleURI u) model = model {uri = u} <# pure NoOp move (ChangeURI u) model = model <# do pushURI u @@ -162,8 +162,8 @@ move ToggleFullscreen model = model {cpState = newState} <# do Reading Spread c n -> (Fullscreen.request, Reading Spread c n) -- otherwise, do nothing: x -> (pure, x) -move (SetMediaInfo x) model = model {dMediaInfo = x} <# do - case x of +move (SetMediaInfo x) model = model {dMediaInfo = x} + <# case x of Just Comic {comicId = id} -> pure $ ScrollIntoView $ "comic-" <> ms id Nothing -> diff --git a/Hero/Database.hs b/Hero/Database.hs index 0166c6f..5b7f75d 100644 --- a/Hero/Database.hs +++ b/Hero/Database.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-orphans #-} diff --git a/Hero/Look.hs b/Hero/Look.hs index 662b223..b676c13 100644 --- a/Hero/Look.hs +++ b/Hero/Look.hs @@ -27,17 +27,12 @@ main = do -- base ".fixed" ? position fixed ".clickable" ? clickable - ".row" ? do - display flex - alignItems center - justifyContent spaceBetween + ".row" ? centerJustify a <> a # hover <> a # visited ? do color white textDecoration none ".loading" ? do - display flex - justifyContent center - alignItems center + centered height $ vh 100 width $ vw 100 -- animations @@ -113,7 +108,7 @@ main = do "#app-foot" ? do alignSelf flexEnd bottom (px 0) - mobile $ remove + mobile remove "#app-foot-social" ? do display flex flexDirection column @@ -127,20 +122,17 @@ main = do textTransform Clay.uppercase textAlign center -- hide app-foot-quote when it gets crowded - query Clay.all [Media.maxDeviceWidth (px 800)] $ + query + Clay.all + [Media.maxDeviceWidth (px 800)] hide -- login "#login" ? do -- TODO: next 3 lines can be DRYed up, methinks - display flex - justifyContent center - alignItems center - alignSelf center + centered height (vh 100) "#login-inner" ? do - display flex - justifyContent center - alignItems center + centered flexDirection column zIndex 1 height (vh 100) @@ -151,8 +143,8 @@ main = do display flex alignItems center flexDirection column - "#login" ** form <> "#login" ** hr ? do - width (pct 100) + "#login" ** form <> "#login" ** hr + ? width (pct 100) "#login" ** hr ? border solid (px 1) grai "#login" ** ".button" ? do marginTop (px 10) @@ -228,7 +220,7 @@ main = do lineHeight z let m = 24 :: Double top $ px $ navbarHeight + m - left $ px $ m + left $ px m zIndex 999 -- zoom button and slider "#zoom-button" ? do @@ -259,9 +251,7 @@ main = do borderTop solid (px 1) white borderBottom solid (px 1) white flexDirection row - display flex - alignItems center - justifyContent spaceBetween + centerJustify mobile $ do margin (rem 2) 0 (rem 2) 0 padding 0 0 0 (rem 0) @@ -277,7 +267,7 @@ main = do width (vw 90) -- this line can be commented if you want to center the meta img ? width (px 150) order (-1) - Flexbox.flex 1 1 (auto) + Flexbox.flex 1 1 auto ".media-info-summary" ? do Flexbox.flex 2 1 (px 0) paddingRight (rem 3) @@ -293,7 +283,7 @@ main = do mobile $ do maxWidth (vw 100) flexDirection row - order (1) + order 1 flexBasis auto -- initial height (px 50) -- appmenu @@ -333,9 +323,8 @@ main = do button ? margin (rem 0.5) 0 (rem 0.5) 0 -- feature "#featured-comic" ? do - display flex + centered flexDirection column - justifyContent center Typo.euro height (px 411) mobile $ do @@ -347,8 +336,8 @@ main = do background $ linearGradient (straight sideTop) - [ (setA 0 nite, (pct 0)), - (nite, (pct 100)) + [ (setA 0 nite, pct 0), + (nite, pct 100) ] let h = 149 marginTop (px (- h)) @@ -360,7 +349,7 @@ main = do fontSize (rem 1.2) ".description" ? do width (px 400) - mobile $ remove + mobile remove "#featured-banner" ? do position relative minHeight (px 411) @@ -415,9 +404,8 @@ main = do padding (rem 0.5) (rem 0.5) (rem 0.5) (rem 0.5) width (vw 100) ".comic" ? do - display flex + centered flexDirection column - justifyContent center textAlign center euro maxWidth (px 110) @@ -449,9 +437,18 @@ main = do navbarHeight :: Double navbarHeight = 74 ---------------------------------------------------------------------------------- --- utilities ---------------------------------------------------------------------------------- +centered :: Css +centered = do + display flex + justifyContent center + alignItems center + alignSelf center + +centerJustify :: Css +centerJustify = do + display flex + alignItems center + justifyContent spaceBetween hide :: Css hide = visibility hidden @@ -472,7 +469,7 @@ rounded :: Css rounded = borderRadius (px 30) (px 30) (px 30) (px 30) appmenuWidth :: Size LengthUnit -appmenuWidth = (px 67) +appmenuWidth = px 67 flexCenter :: Css flexCenter = do diff --git a/Hero/Server.hs b/Hero/Server.hs index 450bd0d..bf92f88 100644 --- a/Hero/Server.hs +++ b/Hero/Server.hs @@ -1,14 +1,12 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE NoImplicitPrelude #-} -- | Hero web app @@ -78,8 +76,8 @@ main = bracket startup shutdown $ uncurry Warp.run Left e -> Exit.die e Right c -> do db <- Database.dummy - say $ "hero" - say $ "port: " ++ (show $ heroPort c) + say "hero" + say $ "port: " ++ show $ heroPort c say $ "client: " ++ heroClient c let waiapp = app db c return (heroPort c, waiapp) @@ -275,7 +273,7 @@ serverHandlers = :<|> chooseExperienceHandler jsonHandlers :: Database.ComicDB -> Server JsonApi -jsonHandlers db = Database.getComics db +jsonHandlers = Database.getComics homeHandler :: Handler (HtmlPage (View Action)) homeHandler = pure . HtmlPage . home $ initModel homeLink |