{- 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.Ticket
    ( getTicketsR
    , postTicketsR
    , getTicketNewR
    , getTicketR
    , putTicketR
    , deleteTicketR
    , postTicketR
    , getTicketEditR
    , postTicketCloseR
    , postTicketOpenR
    , getTicketDiscussionR
    , postTicketDiscussionR
    , getTicketMessageR
    , postTicketMessageR
    , getTicketTopReplyR
    , getTicketReplyR
    )
where

import Prelude

import Control.Monad.IO.Class (liftIO)
import Data.Default.Class (def)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Time.Calendar (Day (..))
import Data.Time.Clock (UTCTime (..), getCurrentTime)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Data.Traversable (for)
import Database.Esqueleto hiding ((==.), (=.), (+=.), update)
import Database.Persist
import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId)
import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (setMessage, redirect, lookupPostParam, notFound)
import Yesod.Form.Functions (runFormGet, runFormPost)
import Yesod.Form.Types (FormResult (..))
import Yesod.Persist.Core (runDB, get404, getBy404)

import qualified Data.Text as T (filter, intercalate, pack)
import qualified Database.Esqueleto as E ((==.))

import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.Handler.Discussion
import Vervis.MediaType (MediaType (Markdown))
import Vervis.Model
import Vervis.Model.Ident
import Vervis.Render (renderSourceT)
import Vervis.Settings (widgetFile)
import Vervis.TicketFilter (filterTickets)
import Vervis.Time (showDate)
import Vervis.Widget.Discussion (discussionW)
import Vervis.Widget.Sharer (personLinkW)

getTicketsR :: ShrIdent -> PrjIdent -> Handler Html
getTicketsR shar proj = do
    ((filtResult, filtWidget), filtEnctype) <- runFormGet ticketFilterForm
    let tf =
            case filtResult of
                FormSuccess filt -> filt
                FormMissing      -> def
                FormFailure l    ->
                    error $ "Ticket filter form failed: " ++ show l
    rows <- runDB $ select $ from $ \ (sharer, project, ticket) -> do
        where_ $ filterTickets tf ticket $
            sharer  ^. SharerIdent   E.==. val shar             &&.
            project ^. ProjectSharer E.==. sharer ^. SharerId   &&.
            project ^. ProjectIdent  E.==. val proj             &&.
            ticket  ^. TicketProject E.==. project ^. ProjectId
        orderBy [asc $ ticket ^. TicketNumber]
        return
            ( ticket ^. TicketNumber
            , sharer
            , ticket ^. TicketTitle
            , ticket ^. TicketDone
            )
    defaultLayout $(widgetFile "ticket/list")

postTicketsR :: ShrIdent -> PrjIdent -> Handler Html
postTicketsR shar proj = do
    ((result, widget), enctype) <- runFormPost newTicketForm
    case result of
        FormSuccess nt -> do
            author <- requireAuthId
            now <- liftIO getCurrentTime
            tnum <- runDB $ do
                Entity pid project <- do
                    Entity sid _sharer <- getBy404 $ UniqueSharer shar
                    getBy404 $ UniqueProject proj sid
                update pid [ProjectNextTicket +=. 1]
                let discussion = Discussion
                        { discussionNextMessage = 1
                        }
                did <- insert discussion
                let ticket = Ticket
                        { ticketProject  = pid
                        , ticketNumber   = projectNextTicket project
                        , ticketCreated  = now
                        , ticketCreator  = author
                        , ticketTitle    = ntTitle nt
                        , ticketDesc     = ntDesc nt
                        , ticketAssignee = Nothing
                        , ticketDone     = False
                        , ticketClosed   = UTCTime (ModifiedJulianDay 0) 0
                        , ticketCloser   = author
                        , ticketDiscuss  = did
                        }
                insert_ ticket
                return $ ticketNumber ticket
            setMessage "Ticket created."
            redirect $ TicketR shar proj tnum
        FormMissing -> do
            setMessage "Field(s) missing."
            defaultLayout $(widgetFile "ticket/new")
        FormFailure _l -> do
            setMessage "Ticket creation failed, see errors below."
            defaultLayout $(widgetFile "ticket/new")

getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
getTicketNewR shar proj = do
    ((_result, widget), enctype) <- runFormPost newTicketForm
    defaultLayout $(widgetFile "ticket/new")

getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketR shar proj num = do
    (author, massignee, closer, ticket) <- runDB $ do
        ticket <- do
            Entity s _ <- getBy404 $ UniqueSharer shar
            Entity p _ <- getBy404 $ UniqueProject proj s
            Entity _ t <- getBy404 $ UniqueTicket p num
            return t
        author <- do
            person <- get404 $ ticketCreator ticket
            get404 $ personIdent person
        massignee <- for (ticketAssignee ticket) $ \ pid -> do
            person <- get404 pid
            get404 $ personIdent person
        closer <-
            if ticketDone ticket
                then do
                    person <- get404 $ ticketCloser ticket
                    get404 $ personIdent person
                else return author
        return (author, massignee, closer, ticket)
    let desc = renderSourceT Markdown $ T.filter (/= '\r') $ ticketDesc ticket
        discuss =
            discussionW
                (return $ ticketDiscuss ticket)
                (TicketTopReplyR shar proj num)
                (TicketReplyR shar proj num)
    defaultLayout $(widgetFile "ticket/one")

putTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
putTicketR shar proj num = do
    Entity tid ticket <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharer shar
        Entity pid _project <- getBy404 $ UniqueProject proj sid
        getBy404 $ UniqueTicket pid num
    ((result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
    case result of
        FormSuccess ticket' -> do
            runDB $ replace tid ticket'
            setMessage "Ticket updated."
            redirect $ TicketR shar proj num
        FormMissing -> do
            setMessage "Field(s) missing."
            defaultLayout $(widgetFile "ticket/edit")
        FormFailure _l -> do
            setMessage "Ticket update failed, see errors below."
            defaultLayout $(widgetFile "ticket/edit")

deleteTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
deleteTicketR shar proj num =
    --TODO: I can easily implement this, but should it even be possible to
    --delete tickets?
    error "Not implemented"

postTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketR shar proj num = do
    mmethod <- lookupPostParam "_method"
    case mmethod of
        Just "PUT"    -> putTicketR shar proj num
        Just "DELETE" -> deleteTicketR shar proj num
        _             -> notFound

getTicketEditR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketEditR shar proj num = do
    Entity _tid ticket <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharer shar
        Entity pid _project <- getBy404 $ UniqueProject proj sid
        getBy404 $ UniqueTicket pid num
    ((_result, widget), enctype) <- runFormPost $ editTicketContentForm ticket
    defaultLayout $(widgetFile "ticket/edit")

postTicketCloseR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketCloseR shr prj num = do
    pid <- requireAuthId
    now <- liftIO getCurrentTime
    succ <- runDB $ do
        Entity tid ticket <- do
            Entity s _ <- getBy404 $ UniqueSharer shr
            Entity p _ <- getBy404 $ UniqueProject prj s
            getBy404 $ UniqueTicket p num
        if ticketDone ticket
            then return False
            else do
                update tid
                    [ TicketDone   =. True
                    , TicketClosed =. now
                    , TicketCloser =. pid
                    ]
                return True
    setMessage $
        if succ
            then "Ticket closed."
            else "Ticket is already closed."
    redirect $ TicketR shr prj num

postTicketOpenR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketOpenR shr prj num = do
    pid <- requireAuthId
    now <- liftIO getCurrentTime
    succ <- runDB $ do
        Entity tid ticket <- do
            Entity s _ <- getBy404 $ UniqueSharer shr
            Entity p _ <- getBy404 $ UniqueProject prj s
            getBy404 $ UniqueTicket p num
        if ticketDone ticket
            then do
                update tid
                    [ TicketDone   =. False
                    , TicketCloser =. ticketCreator ticket
                    ]
                return True
            else return False
    setMessage $
        if succ
            then "Ticket reopened"
            else "Ticket is already open."
    redirect $ TicketR shr prj num

selectDiscussionId :: ShrIdent -> PrjIdent -> Int -> AppDB DiscussionId
selectDiscussionId shar proj tnum = do
    Entity sid _sharer <- getBy404 $ UniqueSharer shar
    Entity pid _project <- getBy404 $ UniqueProject proj sid
    Entity _tid ticket <- getBy404 $ UniqueTicket pid tnum
    return $ ticketDiscuss ticket

getTicketDiscussionR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketDiscussionR shar proj num =
    getDiscussion
        (TicketReplyR shar proj num)
        (TicketTopReplyR shar proj num)
        (selectDiscussionId shar proj num)

postTicketDiscussionR :: ShrIdent -> PrjIdent -> Int -> Handler Html
postTicketDiscussionR shar proj num =
    postTopReply
        (TicketDiscussionR shar proj num)
        (const $ TicketR shar proj num)
        (selectDiscussionId shar proj num)

getTicketMessageR :: ShrIdent -> PrjIdent -> Int -> Int -> Handler Html
getTicketMessageR shar proj tnum cnum =
    getMessage
        (TicketReplyR shar proj tnum)
        (selectDiscussionId shar proj tnum)
        cnum

postTicketMessageR :: ShrIdent -> PrjIdent -> Int -> Int -> Handler Html
postTicketMessageR shar proj tnum cnum =
    postReply
        (TicketReplyR shar proj tnum)
        (TicketMessageR shar proj tnum)
        (const $ TicketR shar proj tnum)
        (selectDiscussionId shar proj tnum)
        cnum

getTicketTopReplyR :: ShrIdent -> PrjIdent -> Int -> Handler Html
getTicketTopReplyR shar proj num =
    getTopReply $ TicketDiscussionR shar proj num

getTicketReplyR :: ShrIdent -> PrjIdent -> Int -> Int -> Handler Html
getTicketReplyR shar proj tnum cnum =
    getReply
        (TicketReplyR shar proj tnum)
        (TicketMessageR shar proj tnum)
        (selectDiscussionId shar proj tnum)
        cnum