Ticket view page

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

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 :: ProjectId -> Int -> PersonId -> AForm Handler Ticket
-newTicketAForm pid number = 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 :: ProjectId -> Int -> PersonId -> Form Ticket
-newTicketForm pid number = renderDivs $ newTicketAForm pid number
+newTicketForm pid number author = renderDivs $ newTicketAForm pid number author

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
+    --tickets <- runDB $ do
-        Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
+    --    Entity sid _sharer <- getBy404 $ UniqueSharerIdent shar
-        Entity pid _project <- getBy404 $ UniqueProject proj sid
+    --    Entity pid _project <- getBy404 $ UniqueProject proj sid
-        selectList [TicketProject ==. pid] [Asc TicketNumber]
+    --    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")

templates/ticket/list.hamlet

@@ -20,15 +20,18 @@ $# <http://creativecommons.org/publicdomain/zero/1.0/>.
 <table>
   <tr>
     <th>Number
+    <th>Author
     <th>Title
     <th>Done
-  $forall Entity _tid ticket <- tickets
+  $forall
+  (Value number, Value authorIdent, Value mAuthorName, Value title, Value done)
+  <- rows
     <tr>
       <td>
-        <a href=@{TicketR shar proj $ ticketNumber ticket}>
+        <a href=@{TicketR shar proj number}>#{number}
-          #{ticketNumber ticket}
       <td>
-        <a href=@{TicketR shar proj $ ticketNumber ticket}>
+        <a href=@{PersonR authorIdent}>#{fromMaybe authorIdent mAuthorName}
-          #{ticketTitle ticket}
       <td>
-        #{ticketDone ticket}
+        <a href=@{TicketR shar proj number}>#{title}
+      <td>
+        #{done}

templates/ticket/one.hamlet

@@ -0,0 +1,30 @@
+$# 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/>.
+
+<h1>#{shar} :: #{proj} :: Tickets :: ##{num}
+
+<p>
+  Created on #{formatTime defaultTimeLocale "%F" $ ticketCreated ticket} by
+  #{fromMaybe (sharerIdent author) $ sharerName author}
+
+<p>Done: #{ticketDone ticket}
+
+<h2>#{ticketTitle ticket}
+
+<p>
+  Below is the ticket description. It’s supposed to be rendered as Markdown,
+  but for now, temporarily, it’s shown here as plain text.
+
+<code>
+  <pre>#{ticketDesc ticket}