diff --git a/web/src/Main.hs b/web/src/Main.hs index 86a74cb..a9bb637 100644 --- a/web/src/Main.hs +++ b/web/src/Main.hs @@ -1,6 +1,13 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + 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 qualified Database.SQLite.Simple as Db 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.User as User import qualified Within.DBMemorial.Views.Materialize as Materialize +import qualified Within.DBMemorial.Views.Thread as Thread main :: IO () main = do @@ -22,13 +30,24 @@ main = do users <- Db.query_ conn "SELECT * FROM Users WHERE oid='51315c97a4c72da155001b9a' LIMIT 1" :: IO [User.User] 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 S.runSpock 5000 $ S.spockT id $ do - S.middleware $ Static.staticPolicy $ Static.addBase "public" - S.middleware $ RequestLogger.logStdout + S.middleware $ Static.staticPolicy $ Static.addBase "public" + S.middleware $ RequestLogger.logStdout - S.get S.root $ - S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h (User.render user)))) + S.get S.root $ + S.html $ toStrict (renderMarkup (Materialize.base "The OP" (Post.render h (User.render user)))) - S.get "user" $ - S.html $ toStrict (renderMarkup (Materialize.base "The first poster" (User.render user))) + S.get "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))