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.hs18
1 files changed, 7 insertions, 11 deletions
diff --git a/Biz/Ibb/Server.hs b/Biz/Ibb/Server.hs
index b5a7464..e87c55a 100644
--- a/Biz/Ibb/Server.hs
+++ b/Biz/Ibb/Server.hs
@@ -1,8 +1,6 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}
@@ -57,11 +55,11 @@ import System.Environment (lookupEnv)
main :: IO ()
main = do
say "rise: ibb"
- staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO [Char]
- port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int
+ staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO String
+ 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}
@@ -75,8 +73,7 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where
L.meta_ [L.charset_ "utf-8"]
jsRef "/static/ibb.js"
cssRef "/css/main.css"
- L.body_ $ do
- page
+ L.body_ page
where
page = L.toHtml x
jsRef href =
@@ -100,8 +97,7 @@ handle404 _ respond =
$ responseLBS status404 [("Content-Type", "text/html")]
$ renderBS
$ toHtml
- $ HtmlPage
- $ notfound
+ $ HtmlPage notfound
newtype CSS
= CSS
@@ -128,7 +124,7 @@ type Routes =
cssHandlers :: Server CssRoute
cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main
-app :: [Char] -> AcidState Keep.IbbKeep -> Application
+app :: String -> AcidState Keep.IbbKeep -> Application
app staticDir keep =
serve (Proxy @Routes) $
static
@@ -137,7 +133,7 @@ app staticDir keep =
:<|> apiHandlers keep
:<|> Tagged handle404
where
- static = serveDirectoryWith (defaultWebAppSettings $ staticDir)
+ static = serveDirectoryWith (defaultWebAppSettings staticDir)
type ApiRoutes = "people" :> Get '[JSON] [Person]