summaryrefslogtreecommitdiff
path: root/Biz/Ibb/Server.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Biz/Ibb/Server.hs')
-rw-r--r--Biz/Ibb/Server.hs52
1 files changed, 26 insertions, 26 deletions
diff --git a/Biz/Ibb/Server.hs b/Biz/Ibb/Server.hs
index 058bbdc..3e4b662 100644
--- a/Biz/Ibb/Server.hs
+++ b/Biz/Ibb/Server.hs
@@ -56,10 +56,10 @@ main :: IO ()
main = do
say "rise: ibb"
staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO String
- port <- (read . fromMaybe "3000" <$> lookupEnv "PORT") :: IO Int
+ port <- (read <. fromMaybe "3000" <$> lookupEnv "PORT") :: IO Int
keep <- Keep.openLocal "_/keep/"
say "port: 3000"
- run port $ logStdout $ compress $ app staticDir keep
+ run port <| logStdout <| compress <| app staticDir keep
where
compress = gzip def {gzipFiles = GzipCompress}
@@ -68,12 +68,13 @@ newtype HtmlPage a = HtmlPage a
instance L.ToHtml a => L.ToHtml (HtmlPage a) where
toHtmlRaw = L.toHtml
- toHtml (HtmlPage x) = L.doctypehtml_ $ do
- L.head_ $ do
- L.meta_ [L.charset_ "utf-8"]
- jsRef "/static/ibb.js"
- cssRef "/css/main.css"
- L.body_ page
+ toHtml (HtmlPage x) =
+ L.doctypehtml_ <| do
+ L.head_ <| do
+ L.meta_ [L.charset_ "utf-8"]
+ jsRef "/static/ibb.js"
+ cssRef "/css/main.css"
+ L.body_ page
where
page = L.toHtml x
jsRef href =
@@ -94,18 +95,17 @@ type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action
handle404 :: Application
handle404 _ respond =
respond
- $ responseLBS status404 [("Content-Type", "text/html")]
- $ renderBS
- $ toHtml
- $ HtmlPage notfound
+ <| responseLBS status404 [("Content-Type", "text/html")]
+ <| renderBS
+ <| toHtml
+ <| HtmlPage notfound
-newtype CSS
- = CSS
- { unCSS :: Text
- }
+newtype CSS = CSS
+ { unCSS :: Text
+ }
instance MimeRender CSS Text where
- mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict
+ mimeRender _ = Lazy.encodeUtf8 <. Lazy.fromStrict
instance Accept CSS where
contentType _ = "text" // "css" /: ("charset", "utf-8")
@@ -122,16 +122,16 @@ type Routes =
:<|> Raw
cssHandlers :: Server CssRoute
-cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main
+cssHandlers = return <. Lazy.toStrict <. Clay.render <| Look.main
app :: String -> AcidState Keep.IbbKeep -> Application
app staticDir keep =
- serve (Proxy @Routes) $
- static
- :<|> cssHandlers
- :<|> serverHandlers
- :<|> apiHandlers keep
- :<|> Tagged handle404
+ serve (Proxy @Routes)
+ <| static
+ :<|> cssHandlers
+ :<|> serverHandlers
+ :<|> apiHandlers keep
+ :<|> Tagged handle404
where
static = serveDirectoryWith (defaultWebAppSettings staticDir)
@@ -140,9 +140,9 @@ type ApiRoutes = "people" :> Get '[JSON] [Person]
serverHandlers :: Server ServerRoutes
serverHandlers = homeHandler
where
- send f u = pure $ HtmlPage $ f Model {uri = u, people = NotAsked}
+ send f u = pure <| HtmlPage <| f Model {uri = u, people = NotAsked}
homeHandler = send home goHome
-- | for now we just have one api endpoint, which returns all the people
apiHandlers :: AcidState Keep.IbbKeep -> Server ApiRoutes
-apiHandlers keep = Acid.query' keep $ Keep.GetPeople 20
+apiHandlers keep = Acid.query' keep <| Keep.GetPeople 20