diff options
Diffstat (limited to 'Biz/Ibb/Server.hs')
-rw-r--r-- | Biz/Ibb/Server.hs | 52 |
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 |