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

{-# 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
import qualified Network.Wai.Middleware.Static        as Static
import           Text.Blaze.Renderer.Text
import           Web.Spock.Safe                       ((<//>))
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
    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

        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 ("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))