2015-07-29 06:50:25 +00:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
|
2015-07-28 05:03:13 +00:00
|
|
|
module Main where
|
|
|
|
|
2015-07-29 06:50:25 +00:00
|
|
|
import Control.Monad.IO.Class
|
|
|
|
import qualified Data.Map as Map
|
|
|
|
import qualified Data.Text as Text
|
2015-07-28 15:38:30 +00:00
|
|
|
import Data.Text.Lazy (toStrict)
|
2015-07-28 14:28:03 +00:00
|
|
|
import qualified Database.SQLite.Simple as Db
|
2015-07-30 05:23:13 +00:00
|
|
|
import qualified Network.HTTP.Types.Status as Status
|
2015-07-28 14:28:03 +00:00
|
|
|
import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
|
|
|
|
import qualified Network.Wai.Middleware.Static as Static
|
2015-07-28 16:10:57 +00:00
|
|
|
import Text.Blaze.Renderer.Text
|
2015-07-29 07:02:44 +00:00
|
|
|
import Web.Spock ((<//>))
|
|
|
|
import qualified Web.Spock as S
|
2015-07-28 14:28:03 +00:00
|
|
|
import qualified Within.DBMemorial.Post as Post
|
2015-07-28 15:38:30 +00:00
|
|
|
import qualified Within.DBMemorial.User as User
|
2015-07-30 05:23:13 +00:00
|
|
|
import qualified Within.DBMemorial.Views.Error as ErrorView
|
2015-07-28 15:38:30 +00:00
|
|
|
import qualified Within.DBMemorial.Views.Materialize as Materialize
|
2015-07-29 06:50:25 +00:00
|
|
|
import qualified Within.DBMemorial.Views.Thread as Thread
|
2015-07-28 05:03:13 +00:00
|
|
|
|
|
|
|
main :: IO ()
|
2015-07-28 05:54:37 +00:00
|
|
|
main = do
|
2015-07-28 06:29:29 +00:00
|
|
|
conn <- Db.open "../db/posts.db"
|
2015-07-28 05:54:37 +00:00
|
|
|
|
|
|
|
-- Simple tests to prove we're reading from SQLite
|
2015-07-28 06:53:11 +00:00
|
|
|
r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post]
|
2015-07-28 05:54:37 +00:00
|
|
|
let h = head r
|
2015-07-28 20:41:12 +00:00
|
|
|
users <- Db.query_ conn "SELECT * FROM Users WHERE oid='51315c97a4c72da155001b9a' LIMIT 1" :: IO [User.User]
|
2015-07-28 15:51:02 +00:00
|
|
|
let user = head users
|
2015-07-28 05:54:37 +00:00
|
|
|
|
2015-07-29 06:50:25 +00:00
|
|
|
allUsers <- Db.query_ conn "SELECT * FROM Users" :: IO [User.User]
|
|
|
|
let userMap = Map.fromList [(User.oID u, u) | u <- allUsers]
|
|
|
|
|
2015-07-28 05:54:37 +00:00
|
|
|
-- Set up the URL router
|
2015-07-28 06:29:29 +00:00
|
|
|
S.runSpock 5000 $ S.spockT id $ do
|
2015-07-29 06:50:25 +00:00
|
|
|
S.middleware $ Static.staticPolicy $ Static.addBase "public"
|
|
|
|
S.middleware $ RequestLogger.logStdout
|
|
|
|
|
2015-07-30 01:29:28 +00:00
|
|
|
-- Test routes
|
2015-07-29 06:50:25 +00:00
|
|
|
S.get S.root $
|
2015-07-30 01:01:25 +00:00
|
|
|
S.html $ toStrict (renderMarkup (Materialize.render "The OP" (Post.render h user)))
|
2015-07-29 06:50:25 +00:00
|
|
|
|
|
|
|
S.get "user" $
|
2015-07-29 22:29:54 +00:00
|
|
|
S.html $ toStrict (renderMarkup (Materialize.render "The first poster" (User.render user)))
|
2015-07-29 06:50:25 +00:00
|
|
|
|
2015-07-30 01:29:28 +00:00
|
|
|
-- Real routes
|
2015-07-29 06:56:26 +00:00
|
|
|
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]
|
2015-07-28 15:43:49 +00:00
|
|
|
|
2015-07-30 05:23:13 +00:00
|
|
|
case posts of
|
|
|
|
[] -> do
|
|
|
|
S.setStatus Status.status404
|
2015-07-28 15:51:02 +00:00
|
|
|
|
2015-07-30 05:23:13 +00:00
|
|
|
let page = ErrorView.render ("no data for page number " ++ (show id_))
|
|
|
|
|
|
|
|
S.html $ toStrict $ (renderMarkup (Materialize.render (Text.pack ("Can't find page " ++ (show id_))) page))
|
|
|
|
_ -> do
|
|
|
|
let title = "Thread page " ++ (show id_)
|
|
|
|
page = Thread.render id_ posts userMap
|
|
|
|
|
|
|
|
S.html $ toStrict (renderMarkup (Materialize.render (Text.pack title) page))
|