diff options
Diffstat (limited to 'Biz/Ibb/Server.hs')
| -rw-r--r-- | Biz/Ibb/Server.hs | 136 |
1 files changed, 68 insertions, 68 deletions
diff --git a/Biz/Ibb/Server.hs b/Biz/Ibb/Server.hs index 9f1ac5f..b5a7464 100644 --- a/Biz/Ibb/Server.hs +++ b/Biz/Ibb/Server.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} +{-# LANGUAGE NoImplicitPrelude #-} -- | Server -- @@ -27,41 +27,43 @@ -- : dep text module Biz.Ibb.Server where -import Alpha +import Alpha +import Biz.Ibb.Core +import qualified Biz.Ibb.Keep as Keep +import qualified Biz.Ibb.Look as Look import qualified Clay -import Biz.Ibb.Core -import qualified Biz.Ibb.Keep as Keep -import qualified Biz.Ibb.Look as Look -import Network.RemoteData -import Data.Acid ( AcidState ) -import qualified Data.Acid.Abstract as Acid -import Data.Maybe ( fromMaybe ) -import qualified Data.Text.Lazy as Lazy -import qualified Data.Text.Lazy.Encoding as Lazy -import qualified Lucid as L -import Lucid.Base -import Miso -import Network.HTTP.Media ( (//) - , (/:) - ) -import Network.HTTP.Types -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 ) +import Data.Acid (AcidState) +import qualified Data.Acid.Abstract as Acid +import Data.Maybe (fromMaybe) +import qualified Data.Text.Lazy as Lazy +import qualified Data.Text.Lazy.Encoding as Lazy +import qualified Lucid as L +import Lucid.Base +import Miso +import Network.HTTP.Media + ( (//), + (/:), + ) +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 "rise: ibb" staticDir <- fromMaybe "static" <$> lookupEnv "STATIC_DIR" :: IO [Char] - port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int - keep <- Keep.openLocal "_keep/" + port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int + keep <- Keep.openLocal "_keep/" say "port: 3000" run port $ logStdout $ compress $ app staticDir $ keep - where compress = gzip def { gzipFiles = GzipCompress } + where + compress = gzip def {gzipFiles = GzipCompress} newtype HtmlPage a = HtmlPage a deriving (Show, Eq) @@ -75,18 +77,20 @@ instance L.ToHtml a => L.ToHtml (HtmlPage a) where cssRef "/css/main.css" L.body_ $ do page - where - page = L.toHtml x - jsRef href = L.with - (L.script_ mempty) - [ makeAttribute "src" href - , makeAttribute "type" "text/javascript" - , makeAttribute "async" mempty - , makeAttribute "defer" mempty - ] - cssRef href = L.with - (L.link_ mempty) - [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href] + where + page = L.toHtml x + jsRef href = + L.with + (L.script_ mempty) + [ makeAttribute "src" href, + makeAttribute "type" "text/javascript", + makeAttribute "async" mempty, + makeAttribute "defer" mempty + ] + cssRef href = + L.with + (L.link_ mempty) + [L.rel_ "stylesheet", L.type_ "text/css", L.href_ href] type ServerRoutes = ToServerRoutes AppRoutes HtmlPage Action @@ -99,9 +103,10 @@ handle404 _ respond = $ HtmlPage $ notfound -newtype CSS = CSS - { unCSS :: Text - } +newtype CSS + = CSS + { unCSS :: Text + } instance MimeRender CSS Text where mimeRender _ = Lazy.encodeUtf8 . Lazy.fromStrict @@ -111,41 +116,36 @@ instance Accept CSS where type CssRoute = "css" :> "main.css" :> Get '[CSS] Text -type Routes - = "static" - :> - Raw - :<|> - CssRoute - :<|> - ServerRoutes - :<|> - "api" - :> - ApiRoutes - :<|> - Raw +type Routes = + "static" + :> Raw + :<|> CssRoute + :<|> ServerRoutes + :<|> "api" + :> ApiRoutes + :<|> Raw cssHandlers :: Server CssRoute cssHandlers = return . Lazy.toStrict . Clay.render $ Look.main app :: [Char] -> AcidState Keep.IbbKeep -> Application app staticDir keep = - serve (Proxy @Routes) - $ static - :<|> cssHandlers - :<|> serverHandlers - :<|> apiHandlers keep - :<|> Tagged handle404 - where static = serveDirectoryWith (defaultWebAppSettings $ staticDir) + serve (Proxy @Routes) $ + static + :<|> cssHandlers + :<|> serverHandlers + :<|> apiHandlers keep + :<|> Tagged handle404 + where + static = serveDirectoryWith (defaultWebAppSettings $ staticDir) type ApiRoutes = "people" :> Get '[JSON] [Person] serverHandlers :: Server ServerRoutes serverHandlers = homeHandler - where - send f u = pure $ HtmlPage $ f Model { uri = u, people = NotAsked } - homeHandler = send home goHome + where + 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 |