{-# LANGUAGE QuasiQuotes       #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
-------------------------------------------------------------------------------
-- |
-- Module      :  Yesod.Comments
-- Copyright   :  (c) Patrick Brisbin 2010 
-- License     :  as-is
-- Maintainer  :  pbrisbin@gmail.com 
-- Stability   :  unstable
-- Portability :  unportable
--
-- A generic Comments interface for a Yesod application. This module is
-- in the early stages of development. Beware bugs, patches welcome.
--
-------------------------------------------------------------------------------
module Yesod.Comments
    ( addComments
    , addCommentsAuth
    , module Yesod.Comments.Core
    ) where

import Yesod
import Yesod.Comments.Core
import Yesod.Comments.Filters (applyFilters)
import Yesod.Helpers.Auth

-- | Comments that anyone can enter anonymously
addComments :: YesodComments m 
            => ThreadId -- ^ the thread you're adding comments to
            -> GWidget s m ()
addComments tid = do
    comments               <- lift $ loadComments (Just tid)
    cid                    <- lift $ getNextCommentId comments
    ((res, form), enctype) <- lift $ runFormMonadPost commentForm

    handleForm res tid cid
    addStyling
    [hamlet|
        <div .yesod_comments>
            <h4>Add a comment:
            <div .yesod_comment_input>
                <form enctype="#{enctype}" method="post">^{form}
                <p .helptext>Comments are parsed as pandoc-style markdown

            $if not $ null comments
                <h4>Showing #{toHtml $ helper $ length comments}:

                $forall comment <- comments
                    <div .yesod_comment>^{showComment comment}

    |]

-- | Comments that require authentication
addCommentsAuth :: (YesodAuth m, YesodComments m)
                => ThreadId -- ^ the thread you're adding comments to
                -> GWidget s m ()
addCommentsAuth tid = do
    (isAuthenticated, uid, username, email) <- lift $ do
        muid <- maybeAuthId
        case muid of
            Nothing  -> return (False, "", "", "")
            Just uid -> do
                uname <- displayUser uid
                email <- displayEmail uid
                return (True, toSinglePiece uid, uname, email)

    comments               <- lift $ loadComments (Just tid)
    cid                    <- lift $ getNextCommentId comments
    ((res, form), enctype) <- lift $ runFormMonadPost $ commentFormAuth uid username email

    handleForm res tid cid
    addStyling
    [hamlet|
        <div .yesod_comments>
            $if isAuthenticated
                <h4>Add a comment:
                <div .yesod_comment_input>
                    <form enctype="#{enctype}" method="post">^{form}
                    <p .helptext>Comments are parsed as pandoc-style markdown
            $else
                <h4>Please ^{login} to post a comment.

            $if not $ null comments
                <h4>Showing #{toHtml $ helper $ length comments}:

                $forall comment <- comments
                    <div .yesod_comment>^{showCommentAuth comment}
    |]


-- | Add styling common to the auth and non-auth forms
addStyling :: Yesod m => GWidget s m ()
addStyling = addCassius [cassius|
    .yesod_comment_input th
        text-align: left
        vertical-align: top
    .yesod_comment_input textarea
        height: 10ex
        width: 50ex
    .yesod_comment_avatar_input, .yesod_comment_avatar_list
        float: left
    .yesod_comment_avatar_input
        margin-right: 5px
    .yesod_comment_avatar_list
        margin-right: 3px
    |]

-- | Handle the posted form and actually insert the comment
handleForm :: YesodComments m
           => FormResult CommentForm
           -> ThreadId
           -> CommentId
           -> GWidget s m ()
handleForm res tid cid = case res of
    FormMissing    -> return ()
    FormFailure _  -> return ()
    FormSuccess cf -> lift $ do
        comment <- commentFromForm tid cid cf
        matches <- applyFilters commentFilters comment
        if matches
            then setMessage "comment dropped. matched filters."
            else do
                storeComment comment
                setMessage "comment added."
        redirectCurrentRoute

    where
        -- | Redirect back to the current route after a POST request
        redirectCurrentRoute :: Yesod m => GHandler s m ()
        redirectCurrentRoute = do
            tm <- getRouteToMaster
            mr <- getCurrentRoute
            case mr of
                Just r  -> redirect RedirectTemporary $ tm r
                Nothing -> notFound

helper :: Int -> String
helper 0 = "no comments"
helper 1 = "1 comment"
helper n = show n ++ " comments"

-- | Show the authroute as a link if set up
login :: Yesod m => GWidget s m ()
login = do
    lift $ setUltDest' -- so we come back here after login
    mroute <- lift $ fmap authRoute getYesod
    case mroute of
        Just r  -> [hamlet|<a href="@{r}">log in|]
        Nothing -> [hamlet|log in|]