diff --git a/src/Vervis/Form/Ticket.hs b/src/Vervis/Form/Ticket.hs index cb78a16..e76e859 100644 --- a/src/Vervis/Form/Ticket.hs +++ b/src/Vervis/Form/Ticket.hs @@ -28,14 +28,20 @@ import Prelude import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Class (lift) +import Data.Maybe (catMaybes) import Data.Text (Text) import Data.Time.Calendar (Day (..)) import Data.Time.Clock (getCurrentTime, UTCTime (..)) +import Database.Persist import Yesod.Form +import Yesod.Persist.Core (runDB) + +import qualified Data.Text as T (snoc) import Vervis.Field.Ticket -import Vervis.Foundation (Form, Handler) +import Vervis.Foundation (App, Form, Handler) import Vervis.Model +import Vervis.Model.Workflow import Vervis.TicketFilter (TicketFilter (..)) --TODO use custom fields to ensure uniqueness or other constraints? @@ -47,19 +53,39 @@ now :: AForm Handler UTCTime now = lift $ liftIO getCurrentTime data NewTicket = NewTicket - { ntTitle :: Text - , ntDesc :: Text + { ntTitle :: Text + , ntDesc :: Text + , ntTParams :: [(WorkflowFieldId, Text)] } -newTicketAForm :: AForm Handler NewTicket -newTicketAForm = NewTicket - <$> areq textField "Title*" Nothing - <*> ( maybe "" unTextarea <$> - aopt textareaField "Description (Markdown)" Nothing - ) +tfieldSettings :: Text -> Bool -> FieldSettings App +tfieldSettings name req = + fieldSettingsLabel $ + if req + then name `T.snoc` '*' + else name -newTicketForm :: Form NewTicket -newTicketForm = renderDivs newTicketAForm +tfield :: Entity WorkflowField -> AForm Handler (Maybe (WorkflowFieldId, Text)) +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 = Ticket diff --git a/src/Vervis/Handler/Ticket.hs b/src/Vervis/Handler/Ticket.hs index 08e0e68..2329e34 100644 --- a/src/Vervis/Handler/Ticket.hs +++ b/src/Vervis/Handler/Ticket.hs @@ -120,15 +120,16 @@ getTicketsR shar proj = do postTicketsR :: ShrIdent -> PrjIdent -> Handler Html 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 FormSuccess nt -> do author <- requireAuthId now <- liftIO getCurrentTime tnum <- runDB $ do - Entity pid project <- do - Entity sid _sharer <- getBy404 $ UniqueSharer shar - getBy404 $ UniqueProject proj sid update pid [ProjectNextTicket +=. 1] let discussion = Discussion { discussionNextMessage = 1 @@ -147,7 +148,13 @@ postTicketsR shar proj = do , ticketCloser = author , 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 setMessage "Ticket created." redirect $ TicketR shar proj tnum @@ -170,7 +177,11 @@ getTicketTreeR shr prj = do getTicketNewR :: ShrIdent -> PrjIdent -> Handler Html 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") getTicketR :: ShrIdent -> PrjIdent -> Int -> Handler Html