{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -- | Server module Ibb where import Alpha import Biz.Ibb import qualified Biz.Ibb.Keep as Keep import Data.Maybe (fromMaybe) import qualified Lucid as L import Lucid.Base import Miso import Network.HTTP.Types import Network.RemoteData import Network.Wai import Network.Wai.Application.Static import Network.Wai.Handler.Warp import Network.Wai.Middleware.Gzip import Network.Wai.Middleware.RequestLogger import Servant import System.Environment (lookupEnv) main :: IO () main = do say "running: ibb" port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int say "port: 3000" run port $ logStdout $ compress $ app where compress = gzip def { gzipFiles = GzipCompress } newtype HtmlPage a = HtmlPage a deriving (Show, Eq) 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/all.js" L.body_ (L.toHtml x) where jsRef href = L.with (L.script_ mempty) [ makeAttribute "src" href , makeAttribute "type" "text/javascript" , makeAttribute "async" mempty , makeAttribute "defer" mempty ] type ServerRoutes = ToServerRoutes Routes HtmlPage Action handle404 :: Application handle404 _ respond = respond $ responseLBS status404 [("Content-Type", "text/html")] $ renderBS $ toHtml $ HtmlPage $ notfound type Api = "static" :> Raw :<|> ServerRoutes :<|> Raw app :: Application app = serve (Proxy @Api) $ static :<|> serverHandlers :<|> Tagged handle404 where static = serveDirectoryWith (defaultWebAppSettings "ibb.jsexe") serverHandlers :: Server ServerRoutes serverHandlers = homeHandler where send f u = pure $ HtmlPage $ f Model { uri = u, people = NotAsked } homeHandler = send home goHome