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

Main: Refactor the router, show thread pages

This commit is contained in:
Christine Dodrill 2015-07-28 23:50:25 -07:00
parent 968de846a7
commit 4430d6c4f9
1 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
web/src/Main.hs
View File

@ -1,6 +1,13 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where module Main where
import Control.Applicative
import Control.Monad.IO.Class
import Data.Map (Map)
import qualified Data.Map as Map
import qualified Data.Text as Text
import Data.Text.Lazy (toStrict) import Data.Text.Lazy (toStrict)
import qualified Database.SQLite.Simple as Db import qualified Database.SQLite.Simple as Db
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
@ -11,6 +18,7 @@ import qualified Web.Spock.Safe as S
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 qualified Within.DBMemorial.Views.Materialize as Materialize import qualified Within.DBMemorial.Views.Materialize as Materialize
import qualified Within.DBMemorial.Views.Thread as Thread
main :: IO () main :: IO ()
main = do main = do
@ -22,13 +30,24 @@ main = do
users <- Db.query_ conn "SELECT * FROM Users WHERE oid='51315c97a4c72da155001b9a' LIMIT 1" :: IO [User.User] users <- Db.query_ conn "SELECT * FROM Users WHERE oid='51315c97a4c72da155001b9a' LIMIT 1" :: IO [User.User]
let user = head users let user = head users
allUsers <- Db.query_ conn "SELECT * FROM Users" :: IO [User.User]
let userMap = Map.fromList [(User.oID u, u) | u <- allUsers]
-- Set up the URL router -- Set up the URL router
S.runSpock 5000 $ S.spockT id $ do S.runSpock 5000 $ S.spockT id $ do
S.middleware $ Static.staticPolicy $ Static.addBase "public" S.middleware $ Static.staticPolicy $ Static.addBase "public"
S.middleware $ RequestLogger.logStdout S.middleware $ RequestLogger.logStdout
S.get S.root $ S.get S.root $
S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h (User.render user)))) S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h (User.render user))))
S.get "user" $ S.get "user" $
S.html $ toStrict (renderMarkup (Materialize.base "The first poster" (User.render user))) S.html $ toStrict (renderMarkup (Materialize.base "The first poster" (User.render user)))
S.get ("page" <//> S.var) $ \(id :: Int) -> do
posts <- liftIO $ Db.query conn "SELECT * FROM Posts WHERE page=?" (Db.Only (id :: Int)) :: S.ActionT IO [Post.Post]
let title = "Thread page " ++ (show id)
page = Thread.render id posts userMap
S.html $ toStrict (renderMarkup (Materialize.base (Text.pack title) page))