{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} -- | Server module Ibb where import Alpha import Biz.Ibb import Data.Maybe (fromMaybe) import Data.Proxy import qualified Lucid as L import Lucid.Base import Miso import Network.HTTP.Types import Network.Wai 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" port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int 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 "ibb.jsexe/all.js" L.body_ (L.toHtml x) where jsRef href = L.with (L.script_ mempty) [ makeAttribute "src" href , 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 = ServerRoutes :<|> Raw app :: Application app = serve (Proxy @Api) $ serverHandlers :<|> Tagged handle404 serverHandlers :: Server ServerRoutes serverHandlers = homeHandler where send f u = pure $ HtmlPage $ f Model { modelUri = u, people = [] } homeHandler = send home goHome