diff --git a/config/models b/config/models index 9ce65d0..def417b 100644 --- a/config/models +++ b/config/models @@ -68,6 +68,7 @@ Ticket project ProjectId number Int created UTCTime + creator PersonId title Text desc Text -- Assume this is Pandoc Markdown done Bool diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index 7088a65..0620c53 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -32,14 +32,15 @@ import Vervis.Model --TODO stuff like number and created - do I generate them here using monadic -- form or do I rely on handler to provide? which approach is better? -newTicketAForm :: ProjectId -> Int -> AForm Handler Ticket -newTicketAForm pid number = Ticket +newTicketAForm :: ProjectId -> Int -> PersonId -> AForm Handler Ticket +newTicketAForm pid number author = Ticket <$> pure pid <*> pure number <*> lift (liftIO getCurrentTime) + <*> pure author <*> areq textField "Title*" Nothing <*> (maybe "" unTextarea <$> aopt textareaField "Description (Markdown)" Nothing) <*> pure False -newTicketForm :: ProjectId -> Int -> Form Ticket -newTicketForm pid number = renderDivs $ newTicketAForm pid number +newTicketForm :: ProjectId -> Int -> PersonId -> Form Ticket +newTicketForm pid number author = renderDivs $ newTicketAForm pid number author diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index edd0a4e..88e4d2d 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -23,16 +23,21 @@ 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, getBy404) +import Yesod.Persist.Core (runDB, get404, getBy404) -import qualified Data.Text as T (intercalate) +import qualified Data.Text as T (intercalate, pack) +import qualified Database.Esqueleto as E ((==.)) import Vervis.Form.Ticket import Vervis.Foundation @@ -41,10 +46,22 @@ 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] + --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") @@ -58,10 +75,22 @@ getTicketNewR shar proj = do Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar getBy404 $ UniqueProject proj sid let next = projectNextTicket project - ((_result, widget), enctype) <- runFormPost $ newTicketForm pid next + 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 = notFound +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") diff --git a/templates/ticket/list.hamlet b/templates/ticket/list.hamlet index d0ba703..d85c91e 100644 --- a/templates/ticket/list.hamlet +++ b/templates/ticket/list.hamlet @@ -20,15 +20,18 @@ $# .
Number + Author Title Done - $forall Entity _tid ticket <- tickets + $forall + (Value number, Value authorIdent, Value mAuthorName, Value title, Value done) + <- rows
- - #{ticketNumber ticket} + #{number} - - #{ticketTitle ticket} + #{fromMaybe authorIdent mAuthorName} - #{ticketDone ticket} + #{title} + + #{done} diff --git a/templates/ticket/one.hamlet b/templates/ticket/one.hamlet new file mode 100644 index 0000000..96b5da3 --- /dev/null +++ b/templates/ticket/one.hamlet @@ -0,0 +1,30 @@ +$# This file is part of Vervis. +$# +$# Written in 2016 by fr33domlover . +$# +$# ♡ 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 +$# . + +

#{shar} :: #{proj} :: Tickets :: ##{num} + +

+ Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by + #{fromMaybe (sharerIdent author) $ sharerName author} + +

Done: #{ticketDone ticket} + +

#{ticketTitle ticket} + +

+ Below is the ticket description. It’s supposed to be rendered as Markdown, + but for now, temporarily, it’s shown here as plain text. + + + 

#{ticketDesc ticket}