mirror of
https://code.sup39.dev/repos/Wqawg
synced 2024-12-29 00:34:54 +09:00
Include custom ticket text fields in new ticket form
This commit is contained in:
parent
35933061c9
commit
1d0d4f697d
2 changed files with 54 additions and 17 deletions
|
@ -28,14 +28,20 @@ import Prelude
|
||||||
|
|
||||||
import Control.Monad.IO.Class (liftIO)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
|
import Data.Maybe (catMaybes)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
import Data.Time.Calendar (Day (..))
|
import Data.Time.Calendar (Day (..))
|
||||||
import Data.Time.Clock (getCurrentTime, UTCTime (..))
|
import Data.Time.Clock (getCurrentTime, UTCTime (..))
|
||||||
|
import Database.Persist
|
||||||
import Yesod.Form
|
import Yesod.Form
|
||||||
|
import Yesod.Persist.Core (runDB)
|
||||||
|
|
||||||
|
import qualified Data.Text as T (snoc)
|
||||||
|
|
||||||
import Vervis.Field.Ticket
|
import Vervis.Field.Ticket
|
||||||
import Vervis.Foundation (Form, Handler)
|
import Vervis.Foundation (App, Form, Handler)
|
||||||
import Vervis.Model
|
import Vervis.Model
|
||||||
|
import Vervis.Model.Workflow
|
||||||
import Vervis.TicketFilter (TicketFilter (..))
|
import Vervis.TicketFilter (TicketFilter (..))
|
||||||
|
|
||||||
--TODO use custom fields to ensure uniqueness or other constraints?
|
--TODO use custom fields to ensure uniqueness or other constraints?
|
||||||
|
@ -47,19 +53,39 @@ now :: AForm Handler UTCTime
|
||||||
now = lift $ liftIO getCurrentTime
|
now = lift $ liftIO getCurrentTime
|
||||||
|
|
||||||
data NewTicket = NewTicket
|
data NewTicket = NewTicket
|
||||||
{ ntTitle :: Text
|
{ ntTitle :: Text
|
||||||
, ntDesc :: Text
|
, ntDesc :: Text
|
||||||
|
, ntTParams :: [(WorkflowFieldId, Text)]
|
||||||
}
|
}
|
||||||
|
|
||||||
newTicketAForm :: AForm Handler NewTicket
|
tfieldSettings :: Text -> Bool -> FieldSettings App
|
||||||
newTicketAForm = NewTicket
|
tfieldSettings name req =
|
||||||
<$> areq textField "Title*" Nothing
|
fieldSettingsLabel $
|
||||||
<*> ( maybe "" unTextarea <$>
|
if req
|
||||||
aopt textareaField "Description (Markdown)" Nothing
|
then name `T.snoc` '*'
|
||||||
)
|
else name
|
||||||
|
|
||||||
newTicketForm :: Form NewTicket
|
tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text))
|
||||||
newTicketForm = renderDivs newTicketAForm
|
tfield (Entity fid f) =
|
||||||
|
let sets = tfieldSettings (workflowFieldName f) (workflowFieldRequired f)
|
||||||
|
in fmap (fid, ) <$>
|
||||||
|
if workflowFieldRequired f
|
||||||
|
then Just <$> areq textField sets Nothing
|
||||||
|
else aopt textField sets Nothing
|
||||||
|
|
||||||
|
newTicketForm :: WorkflowId -> Form NewTicket
|
||||||
|
newTicketForm wid html = do
|
||||||
|
tfs <-
|
||||||
|
lift $ runDB $
|
||||||
|
selectList
|
||||||
|
[WorkflowFieldWorkflow ==. wid, WorkflowFieldType ==. WFTText]
|
||||||
|
[]
|
||||||
|
flip renderDivs html $ NewTicket
|
||||||
|
<$> areq textField "Title*" Nothing
|
||||||
|
<*> ( maybe "" unTextarea <$>
|
||||||
|
aopt textareaField "Description (Markdown)" Nothing
|
||||||
|
)
|
||||||
|
<*> (catMaybes <$> traverse tfield tfs)
|
||||||
|
|
||||||
editTicketContentAForm :: Ticket -> AForm Handler Ticket
|
editTicketContentAForm :: Ticket -> AForm Handler Ticket
|
||||||
editTicketContentAForm ticket = Ticket
|
editTicketContentAForm ticket = Ticket
|
||||||
|
|
|
@ -120,15 +120,16 @@ getTicketsR shar proj = do
|
||||||
|
|
||||||
postTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
postTicketsR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
postTicketsR shar proj = do
|
postTicketsR shar proj = do
|
||||||
((result, widget), enctype) <- runFormPost newTicketForm
|
Entity pid project <- runDB $ do
|
||||||
|
Entity sid _sharer <- getBy404 $ UniqueSharer shar
|
||||||
|
getBy404 $ UniqueProject proj sid
|
||||||
|
((result, widget), enctype) <-
|
||||||
|
runFormPost $ newTicketForm $ projectWorkflow project
|
||||||
case result of
|
case result of
|
||||||
FormSuccess nt -> do
|
FormSuccess nt -> do
|
||||||
author <- requireAuthId
|
author <- requireAuthId
|
||||||
now <- liftIO getCurrentTime
|
now <- liftIO getCurrentTime
|
||||||
tnum <- runDB $ do
|
tnum <- runDB $ do
|
||||||
Entity pid project <- do
|
|
||||||
Entity sid _sharer <- getBy404 $ UniqueSharer shar
|
|
||||||
getBy404 $ UniqueProject proj sid
|
|
||||||
update pid [ProjectNextTicket +=. 1]
|
update pid [ProjectNextTicket +=. 1]
|
||||||
let discussion = Discussion
|
let discussion = Discussion
|
||||||
{ discussionNextMessage = 1
|
{ discussionNextMessage = 1
|
||||||
|
@ -147,7 +148,13 @@ postTicketsR shar proj = do
|
||||||
, ticketCloser = author
|
, ticketCloser = author
|
||||||
, ticketDiscuss = did
|
, ticketDiscuss = did
|
||||||
}
|
}
|
||||||
insert_ ticket
|
tid <- insert ticket
|
||||||
|
let mkparam (fid, v) = TicketParamText
|
||||||
|
{ ticketParamTextTicket = tid
|
||||||
|
, ticketParamTextField = fid
|
||||||
|
, ticketParamTextValue = v
|
||||||
|
}
|
||||||
|
insertMany_ $ map mkparam $ ntTParams nt
|
||||||
return $ ticketNumber ticket
|
return $ ticketNumber ticket
|
||||||
setMessage "Ticket created."
|
setMessage "Ticket created."
|
||||||
redirect $ TicketR shar proj tnum
|
redirect $ TicketR shar proj tnum
|
||||||
|
@ -170,7 +177,11 @@ getTicketTreeR shr prj = do
|
||||||
|
|
||||||
getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
|
getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html
|
||||||
getTicketNewR shar proj = do
|
getTicketNewR shar proj = do
|
||||||
((_result, widget), enctype) <- runFormPost newTicketForm
|
wid <- runDB $ do
|
||||||
|
Entity sid _ <- getBy404 $ UniqueSharer shar
|
||||||
|
Entity _ j <- getBy404 $ UniqueProject proj sid
|
||||||
|
return $ projectWorkflow j
|
||||||
|
((_result, widget), enctype) <- runFormPost $ newTicketForm wid
|
||||||
defaultLayout $(widgetFile "ticket/new")
|
defaultLayout $(widgetFile "ticket/new")
|
||||||
|
|
||||||
getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html
|
||||||
|
|
Loading…
Reference in a new issue