vervis/src/Vervis/Handler/Ticket.hs

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

import Prelude

import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Time.Format (formatTime, defaultTimeLocale)
import Database.Esqueleto hiding ((==.))
import Database.Persist
import Text.Blaze.Html (Html, toHtml)
import Yesod.Auth (requireAuthId)
import Yesod.Core (defaultLayout)
import Yesod.Core.Handler (notFound)
import Yesod.Core.Widget (setTitle)
import Yesod.Form.Functions (runFormPost)
import Yesod.Persist.Core (runDB, get404, getBy404)

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

import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.Model
import Vervis.Settings (widgetFile)

getTicketsR :: Text -> Text -> Handler Html
getTicketsR shar proj = do
    --tickets <- runDB $ do
    --    Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
    --    Entity pid _project <- getBy404 $ UniqueProject proj sid
    --    selectList [TicketProject ==. pid] [Asc TicketNumber]
    rows <- runDB $ select $ from $ \ (ticket, person, sharer) -> do
        where_ $
            ticket ^. TicketCreator E.==. person ^. PersonId &&.
            person ^. PersonIdent   E.==. sharer ^. SharerId
        orderBy [asc $ ticket ^. TicketNumber]
        return
            ( ticket ^. TicketNumber
            , sharer ^. SharerIdent
            , sharer ^. SharerName
            , ticket ^. TicketTitle
            , ticket ^. TicketDone
            )
    defaultLayout $ do
        setTitle $ toHtml $ T.intercalate " :: " [shar, proj, "Tickes"]
        $(widgetFile "ticket/list")

postTicketsR :: Text -> Text -> Handler Html
postTicketsR shar proj = notFound

getTicketNewR :: Text -> Text -> Handler Html
getTicketNewR shar proj = do
    Entity pid project <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
        getBy404 $ UniqueProject proj sid
    let next = projectNextTicket project
    author <- requireAuthId
    ((_result, widget), enctype) <- runFormPost $ newTicketForm pid next author
    defaultLayout $ do
        setTitle $ toHtml $ T.intercalate " :: " [shar, proj, "New ticket"]
        $(widgetFile "ticket/new")

getTicketR :: Text -> Text -> Int -> Handler Html
getTicketR shar proj num = do
    (author, ticket) <- runDB $ do
        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
        Entity pid _project <- getBy404 $ UniqueProject proj sid
        Entity _tid ticket <- getBy404 $ UniqueTicket pid num
        person <- get404 $ ticketCreator ticket
        author <- get404 $ personIdent person
        return (author, ticket)
    defaultLayout $ do
        setTitle $ toHtml $ T.intercalate " :: "
            [shar, proj, "Tickets", T.pack ('#' : show num)]
        $(widgetFile "ticket/one")