summaryrefslogtreecommitdiff
path: root/Hero/Host.hs
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/Host.hs
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/Host.hs')
-rw-r--r--Hero/Host.hs66
1 files changed, 33 insertions, 33 deletions
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