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