diff --git a/web/src/Main.hs b/web/src/Main.hs index bae1a7c..53223c2 100644 --- a/web/src/Main.hs +++ b/web/src/Main.hs @@ -3,6 +3,7 @@ module Main where +import qualified Clay (render) import Control.Monad.IO.Class import qualified Data.Map as Map import qualified Data.Text as Text @@ -13,8 +14,10 @@ import qualified Network.Wai.Middleware.Static as Static import Text.Blaze.Renderer.Text import Web.Spock (()) 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.User as User +import Within.DBMemorial.Utils import qualified Within.DBMemorial.Views.Materialize as Materialize import qualified Within.DBMemorial.Views.Thread as Thread @@ -36,12 +39,18 @@ main = do S.middleware $ Static.staticPolicy $ Static.addBase "public" 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.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user))) S.get "user" $ S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user))) + -- Real routes S.get ("page" S.var) $ \(id_ :: Int) -> do posts <- liftIO $ Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id_ :: Int)) diff --git a/web/src/Within/DBMemorial/Utils.hs b/web/src/Within/DBMemorial/Utils.hs new file mode 100644 index 0000000..57ed3e0 --- /dev/null +++ b/web/src/Within/DBMemorial/Utils.hs @@ -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 diff --git a/web/src/Within/DBMemorial/Views/Materialize.hs b/web/src/Within/DBMemorial/Views/Materialize.hs index 8c11de1..c964f59 100644 --- a/web/src/Within/DBMemorial/Views/Materialize.hs +++ b/web/src/Within/DBMemorial/Views/Materialize.hs @@ -18,6 +18,7 @@ render pageTitle inner = meta ! charset "utf-8" meta ! name "viewport" ! content "width=device-width, initial-scale=1.0" 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 ! src "/materialize/js/materialize.min.js" $ mempty H.body $ do