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 --- aero/Ibb.hs | 39 +--- apex/Ibb.hs | 158 ++++++----------- lore/Alpha.hs | 18 ++ lore/Biz/Ibb.hs | 422 +------------------------------------------- lore/Biz/Ibb/Core.hs | 80 +++++++++ lore/Biz/Ibb/Influencers.hs | 419 +++++++++++++++++++++++++++++++++++++++++++ lore/Biz/Ibb/Move.hs | 12 ++ pack/ibb.nix | 4 + 8 files changed, 602 insertions(+), 550 deletions(-) create mode 100644 lore/Alpha.hs create mode 100644 lore/Biz/Ibb/Core.hs create mode 100644 lore/Biz/Ibb/Influencers.hs create mode 100644 lore/Biz/Ibb/Move.hs diff --git a/aero/Ibb.hs b/aero/Ibb.hs index e357317..8376060 100644 --- a/aero/Ibb.hs +++ b/aero/Ibb.hs @@ -1,45 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} +-- | Front-end module Ibb where +import Biz.Ibb.Move import Miso -import Miso.String main :: IO () -main = startApp App {..} +main = miso $ \u -> App { model = Model u [], .. } where - initialAction = SayHelloWorld - model = 0 - update = updateModel - view = viewModel + initialAction = Nop + update = move + view = see events = defaultEvents subs = [] mountPoint = Nothing - -type Model = Int - --- | Sum type for application events -data Action - = AddOne - | SubtractOne - | NoOp - | SayHelloWorld - deriving (Show, Eq) - --- | Updates model, optionally introduces side effects -updateModel :: Action -> Model -> Effect Action Model -updateModel AddOne m = (m + 1) <# do - putStrLn "Hiya World" >> pure NoOp -updateModel SubtractOne m = noEff (m - 1) -updateModel NoOp m = noEff m -updateModel SayHelloWorld m = m <# do - putStrLn "Hiya World" >> pure NoOp - --- | Constructs a virtual DOM from a model -viewModel :: Model -> View Action -viewModel x = div_ [] - [ button_ [ onClick AddOne ] [ text "+" ] - , text (ms x) - , button_ [ onClick SubtractOne ] [ text "-" ] - ] 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} -