From 77ff3088b9c8ff217c6ed6fb9093a5aabb2ea3ca Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Wed, 27 Mar 2019 09:25:12 -0700 Subject: working miso app structure is in place, need to add styles and logic --- apex/Ibb.hs | 158 ++++++++++++++++++++++-------------------------------------- 1 file changed, 57 insertions(+), 101 deletions(-) (limited to 'apex/Ibb.hs') diff --git a/apex/Ibb.hs b/apex/Ibb.hs index 21c1043..ad9af38 100644 --- a/apex/Ibb.hs +++ b/apex/Ibb.hs @@ -1,118 +1,74 @@ {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeOperators #-} +-- | Server module Ibb where -import Biz.Ibb (Person(..), Book(..), allPeople) -import Control.Monad.IO.Class (liftIO) -import Data.ByteString.Lazy (ByteString) +import Alpha +import Biz.Ibb import Data.Maybe (fromMaybe) -import Data.Text.Lazy (Text) -import Data.Text.Lazy.Encoding (encodeUtf8) +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) -import System.Random (newStdGen) -import System.Random.Shuffle (shuffle') -import Text.Blaze (Markup) -import Text.Blaze.Html (Html) -import Text.Blaze.Html.Renderer.Text (renderHtml) -import Text.Hamlet (shamlet) -import Text.Lucius (lucius, renderCss) -import Web.Scotty (ActionM, ScottyM, scotty, get, html, raw, setHeader) - -render :: Html -> ActionM () -render = html . renderHtml - -css :: ByteString -> ActionM () -css src = setHeader "content-type" "text/css" >> raw src main :: IO () main = do - port <- read <$> fromMaybe "3000" <$> lookupEnv "PORT" :: IO Int - scotty port routes + say "running" + port <- read + <$> fromMaybe "3000" + <$> lookupEnv "PORT" :: IO Int + run port $ logStdout $ compress $ app + where + compress = gzip def { gzipFiles = GzipCompress } -routes :: ScottyM () -routes = do - get "/" $ do - r <- liftIO newStdGen - let peopleList = shuffle' allPeople (length allPeople) r - render (homepage peopleList) - get "/custom.css" $ css stylesheet +newtype HtmlPage a = HtmlPage a + deriving (Show, Eq) -displayPerson :: Person -> Markup -displayPerson person = [shamlet| -
- -
-

- #{_name person} -

- - -

- #{_blurb person} -