cadey
/
time-wasting-thread-memorial
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Use rendered CSS

This commit is contained in:
Christine Dodrill 2015-07-29 18:29:28 -07:00
parent 4b10ae7df8
commit 08a953f852
3 changed files with 15 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
web/src/Main.hs
View File

@ -3,6 +3,7 @@
module Main where module Main where
import qualified Clay (render)
import Control.Monad.IO.Class import Control.Monad.IO.Class
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Text as Text import qualified Data.Text as Text
@ -13,8 +14,10 @@ import qualified Network.Wai.Middleware.Static as Static
import Text.Blaze.Renderer.Text import Text.Blaze.Renderer.Text
import Web.Spock ((<//>)) import Web.Spock ((<//>))
import qualified Web.Spock as S import qualified Web.Spock as S
import qualified Within.DBMemorial.CSS.Base as CSSBase
import qualified Within.DBMemorial.Post as Post import qualified Within.DBMemorial.Post as Post
import qualified Within.DBMemorial.User as User import qualified Within.DBMemorial.User as User
import Within.DBMemorial.Utils
import qualified Within.DBMemorial.Views.Materialize as Materialize import qualified Within.DBMemorial.Views.Materialize as Materialize
import qualified Within.DBMemorial.Views.Thread as Thread import qualified Within.DBMemorial.Views.Thread as Thread
@ -36,12 +39,18 @@ main = do
S.middleware $ Static.staticPolicy $ Static.addBase "public" S.middleware $ Static.staticPolicy $ Static.addBase "public"
S.middleware $ RequestLogger.logStdout S.middleware $ RequestLogger.logStdout
-- CSS routes
S.get ("css" <//> "base.css") $
CSSBase.render & Clay.render & toStrict & S.text
-- Test routes
S.get S.root $ S.get S.root $
S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user))) S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user)))
S.get "user" $ S.get "user" $
S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user))) S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user)))
-- Real routes
S.get ("page" <//> S.var) $ \(id_ :: Int) -> do S.get ("page" <//> S.var) $ \(id_ :: Int) -> do
posts <- liftIO $ posts <- liftIO $
Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id_ :: Int)) Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id_ :: Int))

5
web/src/Within/DBMemorial/Utils.hs Normal file
View File

@ -0,0 +1,5 @@
module Within.DBMemorial.Utils where
-- https://hackage.haskell.org/package/base-4.8.0.0/docs/src/Data-Function.html#%26
(&) :: a -> (a -> b) -> b
x & f = f x

1
web/src/Within/DBMemorial/Views/Materialize.hs
View File

@ -18,6 +18,7 @@ render pageTitle inner =
meta ! charset "utf-8" meta ! charset "utf-8"
meta ! name "viewport" ! content "width=device-width, initial-scale=1.0" meta ! name "viewport" ! content "width=device-width, initial-scale=1.0"
link ! rel "stylesheet" ! href "/materialize/css/materialize.min.css" link ! rel "stylesheet" ! href "/materialize/css/materialize.min.css"
link ! rel "stylesheet" ! href "/css/base.css"
script ! type_ "text/javascript" ! src "https://code.jquery.com/jquery-2.1.1.min.js" $ mempty script ! type_ "text/javascript" ! src "https://code.jquery.com/jquery-2.1.1.min.js" $ mempty
script ! src "/materialize/js/materialize.min.js" $ mempty script ! src "/materialize/js/materialize.min.js" $ mempty
H.body $ do H.body $ do