1
0
Fork 0
mirror of https://code.sup39.dev/repos/Wqawg synced 2025-01-10 16:36:46 +09:00
vervis/src/Vervis/Handler/Ticket.hs

68 lines
2.1 KiB
Haskell
Raw Normal View History

2016-05-01 07:32:22 +09:00
{- 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/>.
-}
module Vervis.Handler.Ticket
( getTicketsR
, postTicketsR
, getTicketNewR
2016-05-01 08:02:44 +09:00
, getTicketR
2016-05-01 07:32:22 +09:00
)
where
import Prelude
import Data.Text (Text)
2016-05-01 08:02:44 +09:00
import Database.Persist
2016-05-01 07:32:22 +09:00
import Text.Blaze.Html (Html, toHtml)
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 qualified Data.Text as T (intercalate)
import Vervis.Form.Ticket
import Vervis.Foundation
import Vervis.Model
import Vervis.Settings (widgetFile)
getTicketsR :: Text -> Text -> Handler Html
2016-05-01 08:02:44 +09:00
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]
defaultLayout $ do
setTitle $ toHtml $ T.intercalate " :: " [shar, proj, "Tickes"]
$(widgetFile "ticket/list")
2016-05-01 07:32:22 +09:00
postTicketsR :: Text -> Text -> Handler Html
postTicketsR shar proj = notFound
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
((_result, widget), enctype) <- runFormPost $ newTicketForm pid next
defaultLayout $ do
setTitle $ toHtml $ T.intercalate " :: " [shar, proj, "New ticket"]
$(widgetFile "ticket/new")
2016-05-01 08:02:44 +09:00
getTicketR :: Text -> Text -> Int -> Handler Html
getTicketR shar proj num = notFound