{- This file is part of Vervis.
 -
 - Written in 2016 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Vervis.Handler.Discussion
    ( getDiscussion
    , getMessage
    , getReply
    , postReply
    )
where

import Prelude

import Control.Monad.IO.Class (liftIO)
import Data.Time.Clock (getCurrentTime)
import Database.Persist
import Text.Blaze.Html (Html)
import Yesod.Auth (requireAuthId)
import Yesod.Core (Route, defaultLayout)
import Yesod.Core.Handler (setMessage, redirect)
import Yesod.Form.Functions (runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)

import Vervis.Form.Discussion
import Vervis.Foundation (App, Handler)
import Vervis.Model
import Vervis.Settings (widgetFile)
import Vervis.Widget.Discussion

getDiscussion :: (Int -> Route App) -> DiscussionId -> Handler Html
getDiscussion reply did = defaultLayout $ discussionW did reply

getMessage :: (Int -> Route App) -> DiscussionId -> Int -> Handler Html
getMessage reply did num = do
    (msg, shr) <- runDB $ do
        Entity _mid m <- getBy404 $ UniqueMessage did num
        p <- get404 $ messageAuthor m
        s <- get404 $ personIdent p
        return (m, s)
    now <- liftIO getCurrentTime
    defaultLayout $ messageW now shr msg reply

getReply
    :: (Int -> Route App)
    -> (Int -> Route App)
    -> DiscussionId
    -> Int
    -> Handler Html
getReply replyG replyP did num = do
    (msg, shr) <- runDB $ do
        Entity _mid m <- getBy404 $ UniqueMessage did num
        p <- get404 $ messageAuthor m
        s <- get404 $ personIdent p
        return (m, s)
    now <- liftIO getCurrentTime
    ((_result, widget), enctype) <- runFormPost newMessageForm
    defaultLayout $(widgetFile "discussion/reply")

postReply
    :: (Int -> Route App)
    -> (Int -> Route App)
    -> (Int -> Route App)
    -> DiscussionId
    -> Int
    -> Handler Html
postReply replyG replyP after did cnum = do
    ((result, widget), enctype) <- runFormPost newMessageForm
    now <- liftIO getCurrentTime
    case result of
        FormSuccess nm -> do
            author <- requireAuthId
            mnum <- runDB $ do
                (parent, next) <- do
                    discussion <- get404 did
                    Entity mid _message <- getBy404 $ UniqueMessage did cnum
                    return (mid, discussionNextMessage discussion)
                update did [DiscussionNextMessage +=. 1]
                let message = Message
                        { messageAuthor  = author
                        , messageCreated = now
                        , messageContent = nmContent nm
                        , messageParent  = Just parent
                        , messageRoot    = did
                        , messageNumber  = next
                        }
                insert_ message
                return $ messageNumber message
            setMessage "Message submitted."
            redirect $ after mnum
        FormMissing -> do
            setMessage "Field(s) missing."
            (msg, shr) <- runDB $ do
                Entity _mid m <- getBy404 $ UniqueMessage did cnum
                p <- get404 $ messageAuthor m
                s <- get404 $ personIdent p
                return (m, s)
            defaultLayout $(widgetFile "discussion/reply")
        FormFailure _l -> do
            setMessage "Message submission failed, see errors below."
            (msg, shr) <- runDB $ do
                Entity _mid m <- getBy404 $ UniqueMessage did cnum
                p <- get404 $ messageAuthor m
                s <- get404 $ personIdent p
                return (m, s)
            defaultLayout $(widgetFile "discussion/reply")