{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} #if defined(PLZWRK_ENABLE_ASTERIUS) import Asterius.Types import Web.Framework.Plzwrk.Asterius # else import Web.Framework.Plzwrk.MockJSVal # endif import Control.Monad import Data.HashMap.Strict hiding ( null ) import Data.IORef import NeatInterpolation import qualified Data.Set as S import qualified Data.Text as DT import Nouns import Prelude hiding ( div , span ) import Web.Framework.Plzwrk import Web.Framework.Plzwrk.Tag hiding ( main , main_ , main'_ ) import qualified Web.Framework.Plzwrk.Tag as T ( main , main_ , main'_ ) data MyState = MyState { _name :: String , _abstractToConcrete :: [(String, String)] , _myNoun :: String } deriving Show -- here is where we'll show our "surprise" aphorism surprise = (\noun -> if (length noun == 0) then div'_ [] else p'__ $ concat ["Life is like", indefiniteArticle noun, noun] ) <$> _myNoun -- here is where we will input a noun for our "surprise" aphorosim writeSomethingConcrete browser = input [("type", pT "text"), ("style", pT "box-sizing:content-box"), ("input", pF (\e s -> do v <- (eventTargetValue browser) e return $ maybe s (\q -> s { _myNoun = q }) v ) )] [] aphorismList = (\a2c -> ul' [("class", pT "res")] (fmap (\(a, c) -> (li__ (concat [a, " is like", indefiniteArticle c, c]))) a2c ) ) <$> _abstractToConcrete addAphorismButton browser = (\a2c -> button' [("id", pT "incr"), ("class", pT "dim"), ("click", pF (\e s -> do (eventTargetBlur browser) e (consoleLogS browser) $ "Here is the current state " <> show s concept <- randAbstract (mathRandom browser) comparedTo <- randConcrete (mathRandom browser) let newS = s { _abstractToConcrete = (concept, comparedTo) : a2c } (consoleLogS browser) $ "Here is the new state " <> show newS return $ newS ) )] [txt "More aphorisms"] ) <$> _abstractToConcrete removeAphorismButton browser = (\a2c -> button' [("id", pT "decr"), ("class", pT "dim"), ("click", pF (\e s -> do (eventTargetBlur browser) e pure $ s { _abstractToConcrete = if null a2c then [] else tail a2c } ) )] [txt "Less aphorisms"] ) <$> _abstractToConcrete loginText = (\name -> p'_ [txt "Logged in as: ", span [("class", pT "username")] [txt name]]) <$> _name main :: IO () main = do #if defined(PLZWRK_ENABLE_ASTERIUS) browser <- asteriusBrowser # else browser <- makeMockBrowser # endif -- add some css! _head <- (documentHead browser) _style <- (documentCreateElement browser) "style" _css <- (documentCreateTextNode browser) (DT.unpack myCss) (nodeAppendChild browser) _style _css (nodeAppendChild browser) _head _style -- and here is our main div let mainDivF = T.main_ [ section [("class", pT "content")] [ h1__ "Aphorism Machine" , aphorismList , br , surprise , div [("style", pT "width:100%;display:inline-block")] [addAphorismButton browser, removeAphorismButton browser] , writeSomethingConcrete browser , loginText ] ] let state = MyState "Bob" [] "" plzwrk' mainDivF state browser randFromList :: [String] -> IO Double -> IO String randFromList l f = do z <- f let i = round $ (fromIntegral $ length l) * z return $ l !! i indefiniteArticle :: String -> String indefiniteArticle x = let hd = take 1 x in if (hd == "a" || hd == "e" || hd == "i" || hd == "o" || hd == "u") then " an " else " a " randAbstract :: IO Double -> IO String randAbstract = randFromList abstract randConcrete :: IO Double -> IO String randConcrete = randFromList concrete myCss = [text| body { margin: 0; font-family: -apple-system, BlinkMacSystemFont, "Segoe UI", "Roboto", "Oxygen", "Ubuntu", "Cantarell", "Fira Sans", "Droid Sans", "Helvetica Neue", sans-serif; text-rendering: optimizeLegibility; -webkit-font-smoothing: antialiased; } html, body { height: 100%; } body>div:first-child, body>div:first-child>div:first-child, body>div:first-child>div:first-child>div { height: inherit; } input { box-sizing: border-box; padding: 9.5px 15px; border: 0; text-align: center; border-bottom: 1px solid #d8d8d8; font-size: 14px; transition: border-bottom-color 100ms ease-in, color 100ms ease-in; max-width: 250px; border-radius: 0; } input:focus { outline: none; border-color: #000; } .dim { opacity: 1; transition: opacity .15s ease-in; cursor: pointer; } .dim:hover, .dim:focus { opacity: .5; transition: opacity .15s ease-in; } .dim:active { opacity: .8; transition: opacity .15s ease-out; } @media (min-width: 768px) { input { min-width: 300px; max-width: 620px; } } ul { list-style: none; padding-left: 0; } hr { margin-top: 15px; margin-bottom: 15px; width: 70%; } main { width: 100%; height: 100%; display: flex; justify-content: center; align-items: center; padding: 20px; box-sizing: border-box; flex-direction: column; } .content { text-align: center; max-width: 100%; -webkit-animation: fadein 2s; -moz-animation: fadein 2s; -ms-animation: fadein 2s; -o-animation: fadein 2s; animation: fadein 2s; } h1 { font-family: 'Montserrat', sans-serif; font-weight: normal; font-size: 32px; text-align: center; margin-bottom: 25px; } aside { display: flex; justify-content: center; align-items: center; padding: 50px 0 40px 0; position: absolute; bottom: 0; left: 0; right: 0; } aside nav { height: 18px; display: flex; justify-content: center; align-items: center; } aside nav a { font-size: 13px; color: #b2b2b2; text-decoration: none; transition: color 100ms ease-in; } aside nav b { display: block; background: #b2b2b2; width: 1px; height: 100%; margin: 0 10px; } .username { font-weight: 500; } p { font-weight: 400; font-size: 14px; line-height: 24px; max-width: 390px; text-align: center; margin: 14px auto 30px auto; } button { background-color: rgba(0, 0, 0, 0.671); border: none; color: white; padding: 10px 12px; margin: 10px; text-align: center; border-radius: 12px; text-decoration: none; display: inline-block; font-size: 14px; } @keyframes fadein { from { opacity: 0; } to { opacity: 1; } } @-moz-keyframes fadein { from { opacity: 0; } to { opacity: 1; } } @-webkit-keyframes fadein { from { opacity: 0; } to { opacity: 1; } } @media (max-height: 400px) { aside { display: none; } } |]