diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 88e4d2d..388c0ed 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -26,14 +26,15 @@ import Prelude import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time.Format (formatTime, defaultTimeLocale) -import Database.Esqueleto hiding ((==.)) +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 (notFound) +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) @@ -67,7 +68,26 @@ getTicketsR shar proj = do $(widgetFile "ticket/list") postTicketsR :: Text -> Text -> Handler Html -postTicketsR shar proj = notFound +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