{- 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 - . -} module Vervis.Handler.Ticket ( getTicketsR , postTicketsR , getTicketNewR , getTicketR , putTicketR , deleteTicketR , getTicketEditR ) where import Prelude import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time.Format (formatTime, defaultTimeLocale) 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 (redirectUltDest, setMessage) import Yesod.Core.Widget (setTitle) import Yesod.Form.Functions (runFormPost) import Yesod.Form.Types (FormResult (..)) 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 = 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 case result of FormSuccess ticket -> do runDB $ do update pid [ProjectNextTicket +=. 1] insert_ ticket setMessage "Ticket created." redirectUltDest HomeR 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 :: 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") putTicketR :: Text -> Text -> Int -> Handler Html putTicketR shar proj num = error "Not implemented" deleteTicketR :: Text -> Text -> Int -> Handler Html deleteTicketR shar proj num = error "Not implemented" getTicketEditR :: Text -> Text -> Int -> Handler Html getTicketEditR shar proj num = error "Not implemented"