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

{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Main where

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.HTTP.Types.Status            as Status
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.Post               as Post
import qualified Within.DBMemorial.User               as User
import qualified Within.DBMemorial.Views.Error        as ErrorView
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

        -- 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]

            case posts of
                [] -> do
                    S.setStatus Status.status404

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