time-wasting-thread-memorial/web/src/Main.hs

63 lines
2.6 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import qualified Clay (render)
import Control.Monad.IO.Class
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
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
main :: IO ()
main = do
conn <- Db.open "../db/posts.db"
-- Simple tests to prove we're reading from SQLite
r <- Db.query_ conn "SELECT * FROM Posts WHERE page=1" :: IO [Post.Post]
let h = head r
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
-- 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))
:: S.ActionT IO [Post.Post]
let title = "Thread page " ++ (show id_)
page = Thread.render id_ posts userMap
S.html $ toStrict (renderMarkup (Materialize.render (Text.pack title) page))