summaryrefslogtreecommitdiff
path: root/Hero
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2020-11-18 20:20:27 -0500
committerBen Sima <ben@bsima.me>2020-11-18 20:20:27 -0500
commite223b28e6820dcd9fa5c38ba22de487ada2ca0e6 (patch)
tree66061bca039242bc55338280f767d0ff64d35ba0 /Hero
parentac3d455a9c0dc0b2f4afb88b56db3d16c0508428 (diff)
Extend bild to nix targets properly
Also had to capitalize some stuff, and move some nix files around and rename the metadata directive from 'exe' to 'out' because that just makes more sense, and fix some compiler errors. But now bild treats both nix and hs files as buildable things. So that's cool. One interesting example is Biz/Pie.{nix,hs} - I can either create a dev build of the hs file with ghc, or I can create a fully-encapsulated nix build. Its nice to have both options because a dev build with ghc takes half the amount of time, and I can rely on my locally cached hi and ho files. I think this shows the power of bild, but also can be a somewhat subtle thing. The issue really is with the separate command calls in nix builds vs dev builds. I figure there are a few ways to fix this: 1. Try to use bild inside the nix rules. That could be interesting, but could also lead to some weird behavior or worm holes forming. 2. Extract the command line invocation into a separate file, some kind of really simple template that gets pulled into both programs. It is important to consider that in the future I might want to have bild do a module-by-module nix build of programs, but I'm not sure how that would effect my choice here.
Diffstat (limited to 'Hero')
-rw-r--r--Hero/Core.hs178
-rw-r--r--Hero/Host.hs66
-rw-r--r--Hero/Look/Typography.hs6
-rw-r--r--Hero/Node.hs2
-rw-r--r--Hero/Prod.nix31
5 files changed, 152 insertions, 131 deletions
diff --git a/Hero/Core.hs b/Hero/Core.hs
index bc53503..8f865da 100644
--- a/Hero/Core.hs
+++ b/Hero/Core.hs
@@ -129,14 +129,14 @@ data Button
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`
+-- then I could e.g. `el <| ToggleAudio audioId audioState`
instance Elemental Button where
el (PlayPause id form) =
button_
[ class_ "button is-large icon",
- onClick $ ToggleAudio id
+ onClick <| ToggleAudio id
]
- [i_ [class_ $ "fa " <> icon] []]
+ [i_ [class_ <| "fa " <> icon] []]
where
icon = case form of
Paused -> "fa-play-circle"
@@ -144,7 +144,7 @@ instance Elemental Button where
el (Arrow act) =
button_
[class_ "button is-large turn-page", onClick act]
- [img_ [src_ $ ms $ Pack.demo <> image <> ".png"]]
+ [img_ [src_ <| ms <| Pack.demo <> image <> ".png"]]
where
image = case act of
PrevPage -> "prev-page"
@@ -154,15 +154,15 @@ instance Elemental Button where
if c `elem` userLibrary u -- in library
then
a_
- [class_ "wrs-button saved", onClick $ ToggleInLibrary c]
- [ img_ [src_ $ ms $ Pack.icon <> "save.svg"],
+ [class_ "wrs-button saved", onClick <| ToggleInLibrary c]
+ [ img_ [src_ <| ms <| Pack.icon <> "save.svg"],
span_ [] [text "saved"]
]
else-- not in library
a_
- [class_ "wrs-button", onClick $ ToggleInLibrary c]
- [ img_ [src_ $ ms $ Pack.icon <> "save.svg"],
+ [class_ "wrs-button", onClick <| ToggleInLibrary c]
+ [ img_ [src_ <| ms <| Pack.icon <> "save.svg"],
span_ [] [text "save"]
]
el (SaveIcon c u) =
@@ -170,46 +170,46 @@ instance Elemental Button where
then
button_
[ class_ "button is-large has-background-black",
- onClick $ ToggleInLibrary c
+ onClick <| ToggleInLibrary c
]
- [img_ [src_ $ ms $ Pack.demo <> "library-add.png"]]
+ [img_ [src_ <| ms <| Pack.demo <> "library-add.png"]]
else-- not in library
button_
[ class_ "button is-large has-background-black-bis",
- onClick $ ToggleInLibrary c
+ onClick <| ToggleInLibrary c
]
- [img_ [src_ $ ms $ Pack.demo <> "library-add.png"]]
+ [img_ [src_ <| ms <| Pack.demo <> "library-add.png"]]
el (ZoomIcon zform comic page) =
button_
[ id_ "zoom-button",
class_ "button is-large",
- onClick $ ToggleZoom comic page
+ onClick <| ToggleZoom comic page
]
- [ img_ [src_ $ ms $ Pack.demo <> "zoom.png"],
+ [ img_ [src_ <| ms <| Pack.demo <> "zoom.png"],
input_
[ type_ "range",
min_ "0",
max_ "100",
disabled_ True,
- value_ $ ms (show zform :: String),
+ value_ <| ms (show zform :: String),
class_ "ctrl",
id_ "zoom"
],
label_
[class_ "ctrl", Miso.for_ "zoom"]
- [text $ ms $ (show zform :: String) ++ "%"]
+ [text <| ms <| (show zform :: String) ++ "%"]
]
el (Read c) =
a_
- [class_ "wrs-button", onClick $ SelectExperience c]
- [ img_ [src_ $ ms $ Pack.icon <> "read.svg"],
+ [class_ "wrs-button", onClick <| SelectExperience c]
+ [ img_ [src_ <| ms <| Pack.icon <> "read.svg"],
span_ [] [text "read"]
]
el (Watch c) =
a_
- [class_ "wrs-button", onClick $ StartWatching c]
- [ img_ [src_ $ ms $ Pack.icon <> "watch.svg"],
+ [class_ "wrs-button", onClick <| StartWatching c]
+ [ img_ [src_ <| ms <| Pack.icon <> "watch.svg"],
span_ [] [text "watch"]
]
@@ -257,12 +257,12 @@ initForm uri_ =
-- | Hacky way to initialize the 'ComicReaderState' from the Api.URI.
detectPlayerState :: Api.URI -> ComicReaderState
-detectPlayerState u = case List.splitOn "/" $ Api.uriPath u of
+detectPlayerState u = case List.splitOn "/" <| Api.uriPath u of
["", "comic", id, pg, "experience"] -> ChooseExperience (ComicId id) (toPage pg)
- ["", "comic", id, _, "video"] -> Watching $ ComicId id
+ ["", "comic", id, _, "video"] -> Watching <| ComicId id
["", "comic", id, pg, "full"] -> Reading Full (ComicId id) (toPage pg)
["", "comic", id, pg] -> Reading Spread (ComicId id) (toPage pg)
- ["", "comic", id] -> Cover $ ComicId id
+ ["", "comic", id] -> Cover <| ComicId id
_ -> NotReading
where
toPage pg = fromMaybe 1 (readMaybe pg :: Maybe PageNumber)
@@ -344,7 +344,7 @@ homeProxy :: Proxy Home
homeProxy = Proxy
homeLink :: Api.URI
-homeLink = linkURI $ Api.safeLink front homeProxy
+homeLink = linkURI <| Api.safeLink front homeProxy
where
front = Proxy :: Proxy Home
@@ -367,7 +367,7 @@ loginProxy :: Proxy Login
loginProxy = Proxy
loginLink :: Api.URI
-loginLink = linkURI $ Api.safeLink pubRoutes loginProxy
+loginLink = linkURI <| Api.safeLink pubRoutes loginProxy
login :: form -> View Move
login _ =
@@ -377,7 +377,7 @@ login _ =
[id_ "login-inner"]
[ img_
[ class_ fadeIn,
- src_ $ ms $ Pack.cdnEdge <> "/old-assets/images/icons/hero-large.png"
+ src_ <| ms <| Pack.cdnEdge <> "/old-assets/images/icons/hero-large.png"
],
hr_ [class_ fadeIn],
form_
@@ -398,14 +398,14 @@ login _ =
],
hr_ [class_ fadeIn],
p_
- [class_ $ "help " <> fadeIn]
+ [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 $ Pack.cdnEdge <> "/old-assets/images/icons/success-her-image.png"
+ src_ <| ms <| Pack.cdnEdge <> "/old-assets/images/icons/success-her-image.png"
]
]
]
@@ -418,7 +418,7 @@ login _ =
type Discover = "discover" :> View Move
discoverLink :: Api.URI
-discoverLink = linkURI $ Api.safeLink routes discoverProxy
+discoverLink = linkURI <| Api.safeLink routes discoverProxy
discoverProxy :: Proxy Discover
discoverProxy = Proxy
@@ -428,7 +428,7 @@ discover form@Form {user = u} =
template
"discover"
[ topbar,
- main_ [id_ "app-body"] $ case appComics form of
+ main_ [id_ "app-body"] <| case appComics form of
NotAsked -> [loading]
Loading -> [loading]
Failure _ -> [nocomics]
@@ -436,7 +436,7 @@ discover form@Form {user = u} =
Success (comic : rest) ->
[ feature comic u,
shelf "Recent Releases" (comic : rest),
- maybeView (`info` u) $ dMediaInfo form
+ maybeView (`info` u) <| dMediaInfo form
],
appmenu,
discoverFooter
@@ -452,11 +452,11 @@ discoverFooter =
[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/"
+ [ 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"]
],
@@ -467,7 +467,7 @@ discoverFooter =
],
div_
[css euro, id_ "app-foot-logo", onClick Dumpform]
- [ a_ [class_ "social-icon", href_ "#"] [img_ [src_ $ ms $ Pack.icon <> "hero-logo.svg"]],
+ [ a_ [class_ "social-icon", href_ "#"] [img_ [src_ <| ms <| Pack.icon <> "hero-logo.svg"]],
span_ [] [text "© Hero Records, Inc. All Rights Reserved"]
]
]
@@ -477,7 +477,7 @@ discoverFooter =
smallImg x lnk =
a_
(attrs lnk)
- [img_ [src_ $ ms $ Pack.cdnEdge <> "/old-assets/images/icons/" <> x]]
+ [img_ [src_ <| ms <| Pack.cdnEdge <> "/old-assets/images/icons/" <> x]]
-- ** comic
@@ -504,12 +504,12 @@ instance IsMediaObject Comic where
[]
[ a_
[ class_ "comic grow clickable",
- id_ $ "comic-" <> ms comicId,
- onClick $ SetMediaInfo $ Just c
+ id_ <| "comic-" <> ms comicId,
+ onClick <| SetMediaInfo <| Just c
]
- [ img_ [src_ $ ms $ Pack.demo <> comicSlug c <> ".png"],
- span_ [] [text $ "Issue #" <> ms comicIssue],
- span_ [] [text $ ms comicName]
+ [ img_ [src_ <| ms <| Pack.demo <> comicSlug c <> ".png"],
+ span_ [] [text <| "Issue #" <> ms comicIssue],
+ span_ [] [text <| ms comicName]
]
]
feature comic lib =
@@ -517,7 +517,7 @@ instance IsMediaObject Comic where
[id_ "featured-comic"]
[ img_
[ id_ "featured-banner",
- src_ $ ms $ Pack.demo <> "feature-banner.png"
+ src_ <| ms <| Pack.demo <> "feature-banner.png"
],
div_
[id_ "featured-content"]
@@ -530,15 +530,15 @@ instance IsMediaObject Comic where
[class_ "comic-logo"]
[ img_
[ src_
- $ ms
- $ Pack.demo <> comicSlug comic <> "-logo.png"
+ <| ms
+ <| Pack.demo <> comicSlug comic <> "-logo.png"
]
],
- div_ [class_ "comic-action-menu"] $
- el <$> [Watch comic, Read comic, Save comic lib],
+ div_ [class_ "comic-action-menu"] <|
+ el </ [Watch comic, Read comic, Save comic lib],
p_
[class_ "description"]
- [ text . ms $ comicDescription comic
+ [ text . ms <| comicDescription comic
]
]
]
@@ -547,22 +547,22 @@ instance IsMediaObject Comic where
[class_ "media-info", css euro]
[ div_
[class_ "media-info-meta"]
- [ column [img_ [src_ $ ms $ Pack.demo <> "dmc-widethumb.png"]],
+ [ column [img_ [src_ <| ms <| Pack.demo <> "dmc-widethumb.png"]],
column
- [ span_ [style_ title] [text $ ms comicName],
- span_ [style_ subtitle] [text $ "Issue #" <> ms comicIssue],
+ [ span_ [style_ title] [text <| ms comicName],
+ span_ [style_ subtitle] [text <| "Issue #" <> ms comicIssue],
span_ [] [text "Released: "],
- span_ [] [text $ "Pages: " <> ms (show comicPages :: String)]
+ span_ [] [text <| "Pages: " <> ms (show comicPages :: String)]
]
],
div_
[class_ "media-info-summary"]
[ p_
- [style_ $ uppercase <> bold <> Look.expanded <> "font-size" =: ".8rem"]
+ [style_ <| uppercase <> bold <> Look.expanded <> "font-size" =: ".8rem"]
[text "Summary"],
- p_ [] [text $ ms comicDescription]
+ p_ [] [text <| ms comicDescription]
],
- div_ [class_ "media-info-actions"] $ el <$> [Save c lib, Read c, Watch c]
+ div_ [class_ "media-info-actions"] <| el </ [Save c lib, Read c, Watch c]
-- , row [ text "credits" ]
]
where
@@ -586,7 +586,7 @@ comicCover :: ComicId -> Form -> View Move
comicCover comicId_ = comicReader comicId_ 1
comicLink :: ComicId -> Api.URI
-comicLink comicId_ = linkURI $ Api.safeLink routes comicProxy comicId_
+comicLink comicId_ = linkURI <| Api.safeLink routes comicProxy comicId_
-- ** chooseExperience
@@ -602,7 +602,7 @@ chooseExperienceProxy = Proxy
chooseExperienceLink :: ComicId -> PageNumber -> Api.URI
chooseExperienceLink id page =
- linkURI $ Api.safeLink routes chooseExperienceProxy id page
+ linkURI <| Api.safeLink routes chooseExperienceProxy id page
chooseExperiencePage :: Comic -> PageNumber -> Form -> View Move
chooseExperiencePage comic page form =
@@ -613,7 +613,7 @@ chooseExperiencePage comic page form =
[id_ "app-body"]
[ h2_ [] [text "Choose Your Musical Experience"],
p_ [] [text experienceBlurb],
- ul_ [] $ li comic </ experiences
+ ul_ [] <| li comic </ experiences
],
appmenu,
comicControls comic page form
@@ -621,14 +621,14 @@ chooseExperiencePage comic page form =
where
li c (name, artist, track) =
li_
- [onClick $ StartReading c]
+ [onClick <| StartReading c]
[ div_
[]
- [ img_ [src_ $ ms $ Pack.demo <> name <> ".png"],
- span_ [] [text $ ms name]
+ [ img_ [src_ <| ms <| Pack.demo <> name <> ".png"],
+ span_ [] [text <| ms name]
],
- span_ [css thicc] [text $ ms artist],
- span_ [] [text $ ms track]
+ span_ [css thicc] [text <| ms artist],
+ span_ [] [text <| ms track]
]
experiences :: [(Text, Text, Text)]
experiences =
@@ -703,7 +703,7 @@ comicReaderSpreadProxy = Proxy
comicReaderSpreadLink :: ComicId -> PageNumber -> Api.URI
comicReaderSpreadLink id page =
- linkURI $ Api.safeLink routes comicReaderSpreadProxy id page
+ linkURI <| Api.safeLink routes comicReaderSpreadProxy id page
comicSpread :: Comic -> PageNumber -> Form -> View Move
comicSpread comic page form =
@@ -740,7 +740,7 @@ comicSpread comic page form =
closeButton :: View Move
closeButton =
a_
- [id_ "close-button", onClick $ ChangeURI discoverLink]
+ [id_ "close-button", onClick <| ChangeURI discoverLink]
[text "x"]
-- * comicReaderFull
@@ -757,7 +757,7 @@ comicReaderFullProxy = Proxy
comicReaderFullLink :: ComicId -> PageNumber -> Api.URI
comicReaderFullLink id page =
- linkURI $ Api.safeLink routes comicReaderFullProxy id page
+ linkURI <| Api.safeLink routes comicReaderFullProxy id page
-- * comicVideo
@@ -773,7 +773,7 @@ comicVideoProxy = Proxy
comicVideoLink :: ComicId -> PageNumber -> Api.URI
comicVideoLink id page =
- linkURI $ Api.safeLink routes comicVideoProxy id page
+ linkURI <| Api.safeLink routes comicVideoProxy id page
frameborder_ :: MisoString -> Attribute action
frameborder_ = textProp "frameborder"
@@ -812,7 +812,7 @@ mediaInfo (Just comic) user =
div_ [class_ "media-info"] [info comic user]
appmenu :: View Move
-appmenu = aside_ [id_ "appmenu"] $ btn </ links
+appmenu = aside_ [id_ "appmenu"] <| btn </ links
where
links =
-- these extra 'discoverLink's are just dummies
@@ -825,9 +825,9 @@ appmenu = aside_ [id_ "appmenu"] $ btn </ links
btn (lnk, img, label) =
a_
[ class_ "button",
- onPreventClick $ ChangeURI lnk
+ onPreventClick <| ChangeURI lnk
]
- [ img_ [src_ $ ms $ Pack.icon <> img],
+ [ img_ [src_ <| ms <| Pack.icon <> img],
span_ [] [text label]
]
@@ -844,7 +844,7 @@ shelf title comics =
div_
[class_ "shelf"]
[ div_ [class_ "shelf-head"] [text title],
- ul_ [class_ "shelf-body"] $ thumbnail </ comics
+ ul_ [class_ "shelf-body"] <| thumbnail </ comics
]
viewOr404 ::
@@ -865,7 +865,7 @@ template id = div_ [id_ id, class_ "app is-black"]
padLeft :: Int -> MisoString
padLeft n
| n < 10 = ms ("0" <> Legacy.show n)
- | otherwise = ms $ Legacy.show n
+ | otherwise = ms <| Legacy.show n
comicControls :: Comic -> PageNumber -> Form -> View Move
comicControls comic page form =
@@ -877,31 +877,31 @@ comicControls comic page form =
]
[ audio_
[id_ audioId, loop_ True, crossorigin_ "anonymous"]
- [source_ [src_ $ ms $ Pack.demo <> "stars-instrumental.mp3"]],
- el $ PlayPause audioId $ cpAudioState form,
+ [source_ [src_ <| ms <| Pack.demo <> "stars-instrumental.mp3"]],
+ el <| PlayPause audioId <| cpAudioState form,
span_
- [css $ euro <> thicc <> smol <> wide]
+ [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
+ [ el <| Arrow PrevPage,
+ span_ [] [text <| leftPage <> "-" <> rightPage <> " of " <> totalpages],
+ el <| Arrow NextPage
],
div_
[class_ "comic-controls-share"]
- [ el $ SaveIcon comic $ user form,
- el $ ZoomIcon (magnification form) 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"] []]
]
]
where
- leftPage = ms . Legacy.show $ page
- rightPage = ms . Legacy.show $ 1 + page
- totalpages = ms . Legacy.show $ comicPages comic
+ leftPage = ms . Legacy.show <| page
+ rightPage = ms . Legacy.show <| 1 + page
+ totalpages = ms . Legacy.show <| comicPages comic
topbar :: View Move
topbar =
@@ -909,9 +909,9 @@ topbar =
[id_ "app-head", class_ "is-black", css euro]
[ a_
[ class_ "button is-medium is-black",
- onClick $ ChangeURI discoverLink
+ onClick <| ChangeURI discoverLink
]
- [img_ [src_ $ ms $ Pack.icon <> "hero-logo.svg"]],
+ [img_ [src_ <| ms <| Pack.icon <> "hero-logo.svg"]],
div_
[id_ "app-head-right"]
[ button_
@@ -919,7 +919,7 @@ topbar =
[i_ [class_ "fas fa-search"] []],
button_
[ class_ "button is-medium is-black is-size-7",
- css $ euro <> wide <> thicc
+ css <| euro <> wide <> thicc
]
[text "News"],
span_
@@ -930,10 +930,10 @@ topbar =
]
row :: [View Move] -> View Move
-row = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.row]
+row = div_ [css <| Clay.display Clay.flex <> Clay.flexDirection Clay.row]
column :: [View Move] -> View Move
-column = div_ [css $ Clay.display Clay.flex <> Clay.flexDirection Clay.column]
+column = div_ [css <| Clay.display Clay.flex <> Clay.flexDirection Clay.column]
-- | Links
the404 :: form -> View Move
diff --git a/Hero/Host.hs b/Hero/Host.hs
index 326738b..d547fa5 100644
--- a/Hero/Host.hs
+++ b/Hero/Host.hs
@@ -14,7 +14,7 @@
-- | Hero web app
--
--- : exe mmc
+-- : out mmc
--
-- : dep acid-state
-- : dep aeson
@@ -90,10 +90,10 @@ main = bracket startup shutdown run
keep <- Keep.open (heroKeep cfg)
skey <- upsertKey (heroSkey cfg)
say "hero"
- prn $ "port: " ++ show (heroPort cfg)
- prn $ "keep: " ++ heroKeep cfg
- prn $ "node: " ++ heroNode cfg
- prn $ "skey: " ++ heroSkey cfg
+ prn <| "port: " ++ show (heroPort cfg)
+ prn <| "keep: " ++ heroKeep cfg
+ prn <| "node: " ++ heroNode cfg
+ prn <| "skey: " ++ heroSkey cfg
let jwts = Auth.defaultJWTSettings skey
cs =
Auth.defaultCookieSettings
@@ -103,7 +103,7 @@ main = bracket startup shutdown run
}
ctx = cs :. jwts :. EmptyContext
proxy = Proxy @(AllRoutes '[Auth.JWT, Auth.Cookie])
- static = serveDirectoryWith $ defaultWebAppSettings $ heroNode cfg
+ static = serveDirectoryWith <| defaultWebAppSettings <| heroNode cfg
server =
-- assets, auth, and the homepage is public
static
@@ -200,13 +200,13 @@ wrapAuth f authResult = case authResult of
Auth.Indefinite -> Auth.throwAll err422
jsonHandlers :: AcidState Keep.HeroKeep -> User -> Server JsonApi
-jsonHandlers keep _ = Acid.query' keep $ Keep.GetComics 10
+jsonHandlers keep _ = Acid.query' keep <| Keep.GetComics 10
type CssRoute = "css" :> "main.css" :> Get '[CSS] Text
cssHandlers :: Server CssRoute
cssHandlers =
- return . Lazy.toStrict . Clay.render $ Typography.main <> Look.main
+ return . Lazy.toStrict . Clay.render <| Typography.main <> Look.main
type AuthRoute =
"auth"
@@ -241,16 +241,16 @@ authHandler ::
authHandler cookieSettings jwtSettings loginForm =
case loginForm of
(LoginForm "ben@bsima.me" "test") ->
- applyCreds $ User "ben@bsima.me" "ben" []
+ applyCreds <| User "ben@bsima.me" "ben" []
(LoginForm "mcovino@heroprojects.io" "test") ->
- applyCreds $ User "mcovino@heroprojects.io" "mike" []
+ applyCreds <| User "mcovino@heroprojects.io" "mike" []
_ -> throwError err401
where
applyCreds usr = do
- mApplyCookies <- liftIO $ Auth.acceptLogin cookieSettings jwtSettings usr
+ mApplyCookies <- liftIO <| Auth.acceptLogin cookieSettings jwtSettings usr
case mApplyCookies of
Nothing -> throwError err401
- Just applyCookies -> return $ applyCookies usr
+ Just applyCookies -> return <| applyCookies usr
-- | See also 'server' above
type AllRoutes auths =
@@ -282,8 +282,8 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
toHtmlRaw = L.toHtml
toHtml (Templated x) = do
L.doctype_
- L.html_ [L.lang_ "en"] $ do
- L.head_ $ do
+ L.html_ [L.lang_ "en"] <| do
+ L.head_ <| do
L.title_ "Hero [alpha]"
L.link_ [L.rel_ "manifest", L.href_ "/manifest.json"]
L.link_ [L.rel_ "icon", L.type_ ""]
@@ -291,7 +291,7 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
L.link_
[ L.rel_ "apple-touch-icon",
L.sizes_ "180x180",
- L.href_ $
+ L.href_ <|
Pack.cdnEdge
<> "/old-assets/images/favicons/apple-touch-icon.png"
]
@@ -299,7 +299,7 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
[ L.rel_ "icon",
L.type_ "image/png",
L.sizes_ "32x32",
- L.href_ $
+ L.href_ <|
Pack.cdnEdge
<> "/old-assets/images/favicons/favicon-32x32.png"
]
@@ -307,19 +307,19 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
[ L.rel_ "icon",
L.type_ "image/png",
L.sizes_ "16x16",
- L.href_ $
+ L.href_ <|
Pack.cdnEdge
<> "/old-assets/images/favicons/favicon-16x16.png"
]
L.link_
[ L.rel_ "manifest",
- L.href_ $
+ L.href_ <|
Pack.cdnEdge
<> "/old-assets/images/favicons/manifest.json"
]
L.link_
[ L.rel_ "mask-icon",
- L.href_ $
+ L.href_ <|
Pack.cdnEdge
<> "/old-assets/images/favicons/safari-pinned-tab.svg"
]
@@ -351,12 +351,12 @@ instance L.ToHtml a => L.ToHtml (Templated a) where
handle404 :: Application
handle404 _ respond =
respond
- $ responseLBS status404 [("Content-Type", "text/html")]
- $ renderBS
- $ toHtml
- $ Templated
- $ the404
- $ initForm homeLink
+ <| responseLBS status404 [("Content-Type", "text/html")]
+ <| renderBS
+ <| toHtml
+ <| Templated
+ <| the404
+ <| initForm homeLink
fontAwesomeRef :: MisoString
fontAwesomeRef = "https://use.fontawesome.com/releases/v5.7.2/css/all.css"
@@ -373,30 +373,30 @@ bulmaRef =
"https://cdnjs.cloudflare.com/ajax/libs/bulma/0.7.2/css/bulma.min.css"
homeHandler :: Handler (Templated (View Move))
-homeHandler = pure . Templated . home $ initForm homeLink
+homeHandler = pure . Templated . home <| initForm homeLink
comicCoverHandler :: ComicId -> Handler (Templated (View Move))
comicCoverHandler id =
- pure . Templated . comicCover id . initForm $ comicLink id
+ pure . Templated . comicCover id . initForm <| comicLink id
comicPageHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicPageHandler id n =
- pure . Templated . comicReader id n . initForm $ comicReaderSpreadLink id n
+ pure . Templated . comicReader id n . initForm <| comicReaderSpreadLink id n
comicPageFullHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicPageFullHandler id n =
- pure . Templated . comicReader id n . initForm $ comicReaderFullLink id n
+ pure . Templated . comicReader id n . initForm <| comicReaderFullLink id n
comicVideoHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
comicVideoHandler id n =
- pure . Templated . comicReader id n . initForm $ comicVideoLink id n
+ pure . Templated . comicReader id n . initForm <| comicVideoLink id n
discoverHandler :: Handler (Templated (View Move))
-discoverHandler = pure . Templated . discover $ initForm discoverLink
+discoverHandler = pure . Templated . discover <| initForm discoverLink
chooseExperienceHandler :: ComicId -> PageNumber -> Handler (Templated (View Move))
chooseExperienceHandler id n =
- pure . Templated . comicReader id n . initForm $ chooseExperienceLink id n
+ pure . Templated . comicReader id n . initForm <| chooseExperienceLink id n
loginHandler :: Handler (Templated (View Move))
-loginHandler = pure . Templated . login $ initForm loginLink
+loginHandler = pure . Templated . login <| initForm loginLink
diff --git a/Hero/Look/Typography.hs b/Hero/Look/Typography.hs
index d51cdbc..9e35ef5 100644
--- a/Hero/Look/Typography.hs
+++ b/Hero/Look/Typography.hs
@@ -52,7 +52,7 @@ fontRoot = Pack.cdnEdge <> "/old-assets/fonts/eurostile/Eurostile"
-- | font faces
fonts :: Css
fonts =
- mconcat $
+ mconcat <|
mkEuro
</ [ ("-Reg.otf", OpenType, fontWeight normal <> fontStyle normal),
("LTStd-Bold.otf", OpenType, thicc <> norm),
@@ -63,9 +63,9 @@ fonts =
]
where
mkEuro :: (Text, FontFaceFormat, Css) -> Css
- mkEuro (sufx, fmt, extra) = fontFace $ do
+ mkEuro (sufx, fmt, extra) = fontFace <| do
fontFamily ["Eurostile"] []
- fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) $ Just fmt]
+ fontFaceSrc [FontFaceSrcUrl (fontRoot <> sufx) <| Just fmt]
extra
-- TODO: add the below to Clay.Font upstream
diff --git a/Hero/Node.hs b/Hero/Node.hs
index 9934fd3..70b8217 100644
--- a/Hero/Node.hs
+++ b/Hero/Node.hs
@@ -5,7 +5,7 @@
-- | Hero app frontend
--
--- : exe mmc.js
+-- : out mmc.js
--
-- : dep aeson
-- : dep clay
diff --git a/Hero/Prod.nix b/Hero/Prod.nix
index d7ab1fe..cc54f95 100644
--- a/Hero/Prod.nix
+++ b/Hero/Prod.nix
@@ -1,5 +1,16 @@
-{ config, pkgs, lib, ... }:
-{
+{ bild, lib }:
+
+# Production server for herocomics.app
+
+bild.os {
+ imports = [
+ ../Biz/OsBase.nix
+ ../Biz/Packages.nix
+ ../Biz/Users.nix
+ ./Service.nix
+ ];
+ networking.hostName = "prod-herocomics";
+ networking.domain = "herocomics.app";
boot.loader.grub.device = "/dev/vda";
fileSystems."/" = { device = "/dev/vda1"; fsType = "ext4"; };
networking = {
@@ -27,8 +38,18 @@
};
};
- services.udev.extraRules = ''
- ATTR{address}=="b2:63:c4:e5:d6:36", NAME="eth0"
- '';
+ services = {
+ herocomics = {
+ enable = true;
+ port = 3000;
+ host = bild.ghc ./Host.hs;
+ node = bild.ghcjs ./Node.hs;
+ keep = "/var/lib/hero";
+ };
+
+ udev.extraRules = ''
+ ATTR{address}=="b2:63:c4:e5:d6:36", NAME="eth0"
+ '';
+ };
}