Ticket view page

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

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")